File Coverage

blib/lib/Regexp/Common/URI.pm
Criterion Covered Total %
statement 19 19 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod 0 1 0.0
total 26 27 96.3


line stmt bran cond sub pod time code
1             package Regexp::Common::URI;
2              
3 72     72   587 use 5.10.0;
  72         155  
4              
5 72     72   268 use strict;
  72         72  
  72         1257  
6 72     72   219 use warnings;
  72         72  
  72         1865  
7 72     72   262 no warnings 'syntax';
  72         81  
  72         1844  
8              
9 72     72   222 use Exporter ();
  72         90  
  72         3052  
10              
11             our @ISA = qw /Exporter/;
12             our @EXPORT_OK = qw /register_uri/;
13              
14 72     72   906 use Regexp::Common qw /pattern clean no_defaults/;
  72         79  
  72         339  
15              
16             our $VERSION = '2017040401';
17              
18             # Use 'require' here, not 'use', so we delay running them after we are compiled.
19             # We also do it using an 'eval'; this saves us from have repeated similar
20             # lines. The eval is further explained in 'perldoc -f require'.
21             my @uris = qw /fax file ftp gopher http pop prospero news tel telnet tv wais/;
22             foreach my $uri (@uris) {
23             eval "require Regexp::Common::URI::$uri";
24             die $@ if $@;
25             }
26              
27             my %uris;
28              
29             sub register_uri {
30 936     936 0 1295 my ($scheme, $uri) = @_;
31 936         2215 $uris {$scheme} = $uri;
32             }
33              
34             pattern name => [qw (URI)],
35             create => sub {my $uri = join '|' => values %uris;
36             $uri =~ s/\(\?k:/(?:/g;
37             "(?k:$uri)";
38             },
39             ;
40              
41             1;
42              
43             __END__