File Coverage

blib/lib/Regexp/Common/URI/RFC1808.pm
Criterion Covered Total %
statement 24 28 85.7
branch 1 2 50.0
condition 1 3 33.3
subroutine 9 9 100.0
pod n/a
total 35 42 83.3


line stmt bran cond sub pod time code
1             package Regexp::Common::URI::RFC1808;
2              
3             BEGIN {
4             # This makes sure 'use warnings' doesn't bomb out on 5.005_*;
5             # warnings won't be enabled on those old versions though.
6 71 50 33 71   1192 if ($] < 5.006 && !exists $INC {"warnings.pm"}) {
7 0         0 $INC {"warnings.pm"} = 1;
8 71     71   225 no strict 'refs';
  71         134  
  71         3408  
9 0         0 *{"warnings::unimport"} = sub {0};
  0         0  
  0         0  
10             }
11             }
12              
13 71     71   261 use strict;
  71         67  
  71         952  
14 71     71   193 use warnings;
  71         78  
  71         1532  
15              
16 71     71   207 use vars qw /$VERSION/;
  71         76  
  71         2896  
17             $VERSION = '2016060801';
18              
19 71     71   228 use vars qw /@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA/;
  71         80  
  71         2890  
20              
21 71     71   215 use Exporter ();
  71         77  
  71         3946  
22             @ISA = qw /Exporter/;
23              
24              
25             my %vars;
26              
27             BEGIN {
28             $vars {low} = [qw /$punctuation $reserved_range $reserved $national
29             $extra $safe $digit $digits $hialpha $lowalpha
30             $alpha $alphadigit $hex $escape $unreserved_range
31             $unreserved $uchar $uchars $pchar_range $pchar
32             $pchars/],
33              
34 71     71   2220 $vars {parts} = [qw /$fragment $query $param $params $segment
35             $fsegment $path $net_loc $scheme $rel_path
36             $abs_path $net_path $relativeURL $generic_RL
37             $absoluteURL $URL/],
38             }
39              
40 71     71   232 use vars map {@$_} values %vars;
  71         69  
  71         164  
  142         35349  
41              
42             @EXPORT = qw /$host/;
43             @EXPORT_OK = map {@$_} values %vars;
44             %EXPORT_TAGS = (%vars, ALL => [@EXPORT_OK]);
45              
46             # RFC 1808, base definitions.
47              
48             # Lowlevel definitions.
49             $punctuation = '[<>#%"]';
50             $reserved_range = q [;/?:@&=];
51             $reserved = "[$reserved_range]";
52             $national = '[][{}|\\^~`]';
53             $extra = "[!*'(),]";
54             $safe = '[-$_.+]';
55              
56             $digit = '[0-9]';
57             $digits = '[0-9]+';
58             $hialpha = '[A-Z]';
59             $lowalpha = '[a-z]';
60             $alpha = '[a-zA-Z]'; # lowalpha | hialpha
61             $alphadigit = '[a-zA-Z0-9]'; # alpha | digit
62              
63             $hex = '[a-fA-F0-9]';
64             $escape = "(?:%$hex$hex)";
65              
66             $unreserved_range = q [-a-zA-Z0-9$_.+!*'(),]; # alphadigit | safe | extra
67             $unreserved = "[$unreserved_range]";
68             $uchar = "(?:$unreserved|$escape)";
69             $uchars = "(?:(?:$unreserved+|$escape)*)";
70              
71             $pchar_range = qq [$unreserved_range:\@&=];
72             $pchar = "(?:[$pchar_range]|$escape)";
73             $pchars = "(?:(?:[$pchar_range]+|$escape)*)";
74              
75              
76             # Parts
77             $fragment = "(?:(?:[$unreserved_range$reserved_range]+|$escape)*)";
78             $query = "(?:(?:[$unreserved_range$reserved_range]+|$escape)*)";
79              
80             $param = "(?:(?:[$pchar_range/]+|$escape)*)";
81             $params = "(?:$param(?:;$param)*)";
82              
83             $segment = "(?:(?:[$pchar_range]+|$escape)*)";
84             $fsegment = "(?:(?:[$pchar_range]+|$escape)+)";
85             $path = "(?:$fsegment(?:/$segment)*)";
86              
87             $net_loc = "(?:(?:[$pchar_range;?]+|$escape)*)";
88             $scheme = "(?:(?:[-a-zA-Z0-9+.]+|$escape)+)";
89              
90             $rel_path = "(?:$path?(?:;$params)?(?:?$query)?)";
91             $abs_path = "(?:/$rel_path)";
92             $net_path = "(?://$net_loc$abs_path?)";
93              
94             $relativeURL = "(?:$net_path|$abs_path|$rel_path)";
95             $generic_RL = "(?:$scheme:$relativeURL)";
96             $absoluteURL = "(?:$generic_RL|" .
97             "(?:$scheme:(?:[$unreserved_range$reserved_range]+|$escape)*))";
98             $URL = "(?:(?:$absoluteURL|$relativeURL)(?:#$fragment)?)";
99              
100              
101             1;
102              
103             __END__