File Coverage

blib/lib/Regexp/Common/URI/RFC2396.pm
Criterion Covered Total %
statement 26 26 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 34 34 100.0


line stmt bran cond sub pod time code
1             package Regexp::Common::URI::RFC2396;
2              
3 71     71   249 use Regexp::Common qw /pattern clean no_defaults/;
  71         128  
  71         319  
4              
5 71     71   246 use strict;
  71         150  
  71         1122  
6 71     71   740 use warnings;
  71         648  
  71         1520  
7              
8 71     71   250 use vars qw /$VERSION/;
  71         68  
  71         3457  
9             $VERSION = '2016060801';
10              
11 71     71   256 use vars qw /@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA/;
  71         75  
  71         3044  
12              
13 71     71   223 use Exporter ();
  71         959  
  71         4799  
14             @ISA = qw /Exporter/;
15              
16              
17             my %vars;
18              
19             BEGIN {
20 71     71   318 $vars {low} = [qw /$digit $upalpha $lowalpha $alpha $alphanum $hex
21             $escaped $mark $unreserved $reserved $pchar $uric
22             $urics $userinfo $userinfo_no_colon $uric_no_slash/];
23 71         173 $vars {parts} = [qw /$query $fragment $param $segment $path_segments
24             $ftp_segments $rel_segment $abs_path $rel_path
25             $path/];
26 71         157 $vars {connect} = [qw /$port $IPv4address $toplabel $domainlabel $hostname
27             $host $hostport $server $reg_name $authority/];
28 71         1934 $vars {URI} = [qw /$scheme $net_path $opaque_part $hier_part
29             $relativeURI $absoluteURI $URI_reference/];
30             }
31              
32 71     71   246 use vars map {@$_} values %vars;
  71         87  
  71         162  
  284         44613  
33              
34             @EXPORT = ();
35             @EXPORT_OK = map {@$_} values %vars;
36             %EXPORT_TAGS = (%vars, ALL => [@EXPORT_OK]);
37              
38             # RFC 2396, base definitions.
39             $digit = '[0-9]';
40             $upalpha = '[A-Z]';
41             $lowalpha = '[a-z]';
42             $alpha = '[a-zA-Z]'; # lowalpha | upalpha
43             $alphanum = '[a-zA-Z0-9]'; # alpha | digit
44             $hex = '[a-fA-F0-9]';
45             $escaped = "(?:%$hex$hex)";
46             $mark = "[\\-_.!~*'()]";
47             $unreserved = "[a-zA-Z0-9\\-_.!~*'()]"; # alphanum | mark
48             # %61-%7A, %41-%5A, %30-%39
49             # a - z A - Z 0 - 9
50             # %21, %27, %28, %29, %2A, %2D, %2E, %5F, %7E
51             # ! ' ( ) * - . _ ~
52             $reserved = "[;/?:@&=+\$,]";
53             $pchar = "(?:[a-zA-Z0-9\\-_.!~*'():\@&=+\$,]|$escaped)";
54             # unreserved | escaped | [:@&=+$,]
55             $uric = "(?:[;/?:\@&=+\$,a-zA-Z0-9\\-_.!~*'()]|$escaped)";
56             # reserved | unreserved | escaped
57             $urics = "(?:(?:[;/?:\@&=+\$,a-zA-Z0-9\\-_.!~*'()]+|" .
58             "$escaped)*)";
59              
60             $query = $urics;
61             $fragment = $urics;
62             $param = "(?:(?:[a-zA-Z0-9\\-_.!~*'():\@&=+\$,]+|$escaped)*)";
63             $segment = "(?:$param(?:;$param)*)";
64             $path_segments = "(?:$segment(?:/$segment)*)";
65             $ftp_segments = "(?:$param(?:/$param)*)"; # NOT from RFC 2396.
66             $rel_segment = "(?:(?:[a-zA-Z0-9\\-_.!~*'();\@&=+\$,]*|$escaped)+)";
67             $abs_path = "(?:/$path_segments)";
68             $rel_path = "(?:$rel_segment(?:$abs_path)?)";
69             $path = "(?:(?:$abs_path|$rel_path)?)";
70              
71             $port = "(?:$digit*)";
72             $IPv4address = "(?:$digit+[.]$digit+[.]$digit+[.]$digit+)";
73             $toplabel = "(?:$alpha"."[-a-zA-Z0-9]*$alphanum|$alpha)";
74             $domainlabel = "(?:(?:$alphanum"."[-a-zA-Z0-9]*)?$alphanum)";
75             $hostname = "(?:(?:$domainlabel\[.])*$toplabel\[.]?)";
76             $host = "(?:$hostname|$IPv4address)";
77             $hostport = "(?:$host(?::$port)?)";
78              
79             $userinfo = "(?:(?:[a-zA-Z0-9\\-_.!~*'();:&=+\$,]+|$escaped)*)";
80             $userinfo_no_colon = "(?:(?:[a-zA-Z0-9\\-_.!~*'();&=+\$,]+|$escaped)*)";
81             $server = "(?:(?:$userinfo\@)?$hostport)";
82              
83             $reg_name = "(?:(?:[a-zA-Z0-9\\-_.!~*'()\$,;:\@&=+]*|$escaped)+)";
84             $authority = "(?:$server|$reg_name)";
85              
86             $scheme = "(?:$alpha"."[a-zA-Z0-9+\\-.]*)";
87              
88             $net_path = "(?://$authority$abs_path?)";
89             $uric_no_slash = "(?:[a-zA-Z0-9\\-_.!~*'();?:\@&=+\$,]|$escaped)";
90             $opaque_part = "(?:$uric_no_slash$urics)";
91             $hier_part = "(?:(?:$net_path|$abs_path)(?:[?]$query)?)";
92              
93             $relativeURI = "(?:(?:$net_path|$abs_path|$rel_path)(?:[?]$query)?";
94             $absoluteURI = "(?:$scheme:(?:$hier_part|$opaque_part))";
95             $URI_reference = "(?:(?:$absoluteURI|$relativeURI)?(?:#$fragment)?)";
96              
97             1;
98              
99             __END__