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   910 use 5.10.0;
  72         302  
4              
5 72     72   485 use strict;
  72         242  
  72         1533  
6 72     72   411 use warnings;
  72         152  
  72         2149  
7 72     72   366 no warnings 'syntax';
  72         154  
  72         2237  
8              
9 72     72   378 use Exporter ();
  72         180  
  72         3617  
10              
11             our @ISA = qw /Exporter/;
12             our @EXPORT_OK = qw /register_uri/;
13              
14 72     72   419 use Regexp::Common qw /pattern clean no_defaults/;
  72         157  
  72         780  
15              
16             our $VERSION = '2017060201';
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 2483 my ($scheme, $uri) = @_;
31 936         3464 $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__