File Coverage

blib/lib/Regexp/Common/URI/gopher.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 28 28 100.0


line stmt bran cond sub pod time code
1             package Regexp::Common::URI::gopher;
2              
3 72     72   254 use Regexp::Common qw /pattern clean no_defaults/;
  72         71  
  72         365  
4 72     72   262 use Regexp::Common::URI qw /register_uri/;
  72         82  
  72         2537  
5 72     72   250 use Regexp::Common::URI::RFC1738 qw /$host $port $uchars/;
  72         80  
  72         5920  
6 72     72   24705 use Regexp::Common::URI::RFC1808 qw /$pchars $pchar_range/;
  72         114  
  72         7500  
7              
8 72     72   321 use strict;
  72         87  
  72         1098  
9 72     72   211 use warnings;
  72         86  
  72         1609  
10              
11 72     72   234 use vars qw /$VERSION/;
  72         78  
  72         13335  
12             $VERSION = '2017040401';
13              
14              
15             my $pchars_notab = "(?:(?:[$pchar_range]+|" .
16             "%(?:[1-9a-fA-F][0-9a-fA-F]|0[0-8a-fA-F]))*)";
17              
18             my $gopherplus_string = $pchars;
19             my $search = $pchars;
20             my $search_notab = $pchars_notab;
21             my $selector = $pchars;
22             my $selector_notab = $pchars_notab;
23             my $gopher_type = "(?:[0-9+IgT])";
24              
25             my $scheme = "gopher";
26             my $uri = "(?k:(?k:$scheme)://(?k:$host)(?::(?k:$port))?" .
27             "/(?k:(?k:$gopher_type)(?k:$selector)))";
28             my $uri_notab = "(?k:(?k:$scheme)://(?k:$host)(?::(?k:$port))?" .
29             "/(?k:(?k:$gopher_type)(?k:$selector_notab)" .
30             "(?:%09(?k:$search_notab)(?:%09(?k:$gopherplus_string))?)?))";
31              
32             register_uri $scheme => $uri;
33              
34             pattern name => [qw (URI gopher -notab=)],
35             create => sub { exists $_ [1] {-notab} &&
36             !defined $_ [1] {-notab} ? $uri_notab : $uri},
37             ;
38              
39             1;
40              
41             __END__