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   229183 use strict;
  6         19  
  6         181  
4 6     6   30 use warnings;
  6         21  
  6         182  
5 6     6   4460 use Text::Balanced qw/extract_bracketed extract_delimited extract_multiple/;
  6         90269  
  6         551  
6 6     6   1461 use parent 'Exporter';
  6         815  
  6         45  
7              
8             # ABSTRACT: Private utilities
9             our $VERSION = '1.15'; # VERSION
10              
11             our @EXPORT_OK = qw/find_anchor_targets pattern_has_capture_groups/;
12              
13             sub find_anchor_targets {
14 4     4 0 111 my $html = shift;
15              
16             my @tags = extract_multiple(
17             $html,
18 4     350   35 [ sub { extract_bracketed($_[0], '<>') } ],
  350         27178  
19             undef, 1
20             );
21              
22             @tags =
23 11         29 map { extract_href($_) } # find related href=
24 4         1036 grep { /^
  34         84  
25             @tags;
26              
27 4         22 return @tags;
28             }
29              
30             sub extract_href {
31 11     11 0 18 my $tag = shift;
32 11 100       68 if($tag =~ /href=(?='|")/gci) {
    50          
33 6         33 my $text = scalar extract_delimited( $tag, q{'"} );
34 6         576 my $delim = substr $text, 0, 1;
35 6         41 $text =~ s/^$delim//;
36 6         35 $text =~ s/$delim$//;
37 6         25 return $text;
38             } elsif ($tag =~ /href=(.*?)(?:\s|\n|>)/i) {
39 5         22 return $1;
40             } else {
41 0         0 return ();
42             }
43             }
44              
45             sub pattern_has_capture_groups {
46 5     5 0 7077 my $re = shift;
47 5         138 "" =~ /|$re/;
48 5         54 return $#+;
49             }
50              
51              
52             1;
53              
54             __END__