File Coverage

blib/lib/Regexp/Common/URI/http.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1             package Regexp::Common::URI::http;
2              
3 72     72   285 use Regexp::Common qw /pattern clean no_defaults/;
  72         84  
  72         324  
4 72     72   283 use Regexp::Common::URI qw /register_uri/;
  72         87  
  72         2765  
5 72     72   253 use Regexp::Common::URI::RFC2396 qw /$host $port $path_segments $query/;
  72         83  
  72         5830  
6              
7 72     72   269 use strict;
  72         81  
  72         1229  
8 72     72   209 use warnings;
  72         70  
  72         1677  
9              
10 72     72   222 use vars qw /$VERSION/;
  72         89  
  72         11216  
11             $VERSION = '2017040401';
12              
13              
14             my $http_uri = "(?k:(?k:http)://(?k:$host)(?::(?k:$port))?" .
15             "(?k:/(?k:(?k:$path_segments)(?:[?](?k:$query))?))?)";
16              
17             my $https_uri = $http_uri; $https_uri =~ s/http/https?/;
18              
19             register_uri HTTP => $https_uri;
20              
21             pattern name => [qw (URI HTTP), "-scheme=http"],
22             create => sub {
23             my $scheme = $_ [1] -> {-scheme};
24             my $uri = $http_uri;
25             $uri =~ s/http/$scheme/;
26             $uri;
27             }
28             ;
29              
30             1;
31              
32             __END__