File Coverage

blib/lib/Alien/Base/ModuleBuild/Utils.pm
Criterion Covered Total %
statement 30 31 96.7
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod 0 3 0.0
total 41 46 89.1


line stmt bran cond sub pod time code
1             package Alien::Base::ModuleBuild::Utils;
2              
3 6     6   204029 use strict;
  6         17  
  6         158  
4 6     6   32 use warnings;
  6         13  
  6         155  
5 6     6   4655 use Text::Balanced qw/extract_bracketed extract_delimited extract_multiple/;
  6         76424  
  6         467  
6 6     6   1353 use parent 'Exporter';
  6         740  
  6         33  
7              
8             # ABSTRACT: Private utilities
9             our $VERSION = '1.16_01'; # TRIAL VERSION
10             $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
11              
12             our @EXPORT_OK = qw/find_anchor_targets pattern_has_capture_groups/;
13              
14             sub find_anchor_targets {
15 4     4 0 93 my $html = shift;
16              
17             my @tags = extract_multiple(
18             $html,
19 4     350   39 [ sub { extract_bracketed($_[0], '<>') } ],
  350         22241  
20             undef, 1
21             );
22              
23             @tags =
24 11         32 map { extract_href($_) } # find related href=
25 4         856 grep { /^
  34         77  
26             @tags;
27              
28 4         31 return @tags;
29             }
30              
31             sub extract_href {
32 11     11 0 18 my $tag = shift;
33 11 100       73 if($tag =~ /href=(?='|")/gci) {
    50          
34 6         28 my $text = scalar extract_delimited( $tag, q{'"} );
35 6         552 my $delim = substr $text, 0, 1;
36 6         63 $text =~ s/^$delim//;
37 6         38 $text =~ s/$delim$//;
38 6         24 return $text;
39             } elsif ($tag =~ /href=(.*?)(?:\s|\n|>)/i) {
40 5         21 return $1;
41             } else {
42 0         0 return ();
43             }
44             }
45              
46             sub pattern_has_capture_groups {
47 5     5 0 6892 my $re = shift;
48 5         134 "" =~ /|$re/;
49 5         32 return $#+;
50             }
51              
52              
53             1;
54              
55             __END__