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   480 use Regexp::Common qw /pattern clean no_defaults/;
  72         170  
  72         455  
4 72     72   428 use Regexp::Common::URI qw /register_uri/;
  72         160  
  72         3066  
5 72     72   435 use Regexp::Common::URI::RFC1738 qw /$host $port $uchars/;
  72         164  
  72         6203  
6 72     72   27476 use Regexp::Common::URI::RFC1808 qw /$pchars $pchar_range/;
  72         234  
  72         8496  
7              
8 72     72   539 use strict;
  72         165  
  72         1384  
9 72     72   346 use warnings;
  72         144  
  72         1762  
10              
11 72     72   374 use vars qw /$VERSION/;
  72         161  
  72         15054  
12             $VERSION = '2017060201';
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__