File Coverage

blib/lib/Regexp/Common/URI/RFC1738.pm
Criterion Covered Total %
statement 25 25 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 33 33 100.0


line stmt bran cond sub pod time code
1             package Regexp::Common::URI::RFC1738;
2              
3 72     72   241 use Regexp::Common qw /pattern clean no_defaults/;
  72         77  
  72         317  
4              
5 72     72   290 use strict;
  72         78  
  72         1098  
6 72     72   195 use warnings;
  72         82  
  72         1504  
7              
8 72     72   217 use vars qw /$VERSION/;
  72         90  
  72         2822  
9             $VERSION = '2017040401';
10              
11 72     72   242 use vars qw /@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA/;
  72         84  
  72         3169  
12              
13 72     72   236 use Exporter ();
  72         112  
  72         4998  
14             @ISA = qw /Exporter/;
15              
16              
17             my %vars;
18              
19             BEGIN {
20 72     72   308 $vars {low} = [qw /$digit $digits $hialpha $lowalpha $alpha $alphadigit
21             $safe $extra $national $punctuation $unreserved
22             $unreserved_range $reserved $uchar $uchars $xchar
23             $xchars $hex $escape/];
24              
25 72         181 $vars {connect} = [qw /$port $hostnumber $toplabel $domainlabel $hostname
26             $host $hostport $user $password $login/];
27              
28 72         2193 $vars {parts} = [qw /$fsegment $fpath $group $article $grouppart
29             $search $database $wtype $wpath $psegment
30             $fieldname $fieldvalue $fieldspec $ppath/];
31             }
32              
33 72     72   270 use vars map {@$_} values %vars;
  72         73  
  72         179  
  216         42323  
34              
35             @EXPORT = qw /$host/;
36             @EXPORT_OK = map {@$_} values %vars;
37             %EXPORT_TAGS = (%vars, ALL => [@EXPORT_OK]);
38              
39             # RFC 1738, base definitions.
40              
41             # Lowlevel definitions.
42             $digit = '[0-9]';
43             $digits = '[0-9]+';
44             $hialpha = '[A-Z]';
45             $lowalpha = '[a-z]';
46             $alpha = '[a-zA-Z]'; # lowalpha | hialpha
47             $alphadigit = '[a-zA-Z0-9]'; # alpha | digit
48             $safe = '[-$_.+]';
49             $extra = "[!*'(),]";
50             $national = '[][{}|\\^~`]';
51             $punctuation = '[<>#%"]';
52             $unreserved_range = q [-a-zA-Z0-9$_.+!*'(),]; # alphadigit | safe | extra
53             $unreserved = "[$unreserved_range]";
54             $reserved = '[;/?:@&=]';
55             $hex = '[a-fA-F0-9]';
56             $escape = "(?:%$hex$hex)";
57             $uchar = "(?:$unreserved|$escape)";
58             $uchars = "(?:(?:$unreserved|$escape)*)";
59             $xchar = "(?:[$unreserved_range;/?:\@&=]|$escape)";
60             $xchars = "(?:(?:[$unreserved_range;/?:\@&=]|$escape)*)";
61              
62             # Connection related stuff.
63             $port = "(?:$digits)";
64             $hostnumber = "(?:$digits\[.]$digits\[.]$digits\[.]$digits)";
65             $toplabel = "(?:$alpha\[-a-zA-Z0-9]*$alphadigit|$alpha)";
66             $domainlabel = "(?:(?:$alphadigit\[-a-zA-Z0-9]*)?$alphadigit)";
67             $hostname = "(?:(?:$domainlabel\[.])*$toplabel)";
68             $host = "(?:$hostname|$hostnumber)";
69             $hostport = "(?:$host(?::$port)?)";
70              
71             $user = "(?:(?:[$unreserved_range;?&=]|$escape)*)";
72             $password = "(?:(?:[$unreserved_range;?&=]|$escape)*)";
73             $login = "(?:(?:$user(?::$password)?\@)?$hostport)";
74              
75             # Parts (might require more if we add more URIs).
76              
77             # FTP/file
78             $fsegment = "(?:(?:[$unreserved_range:\@&=]|$escape)*)";
79             $fpath = "(?:$fsegment(?:/$fsegment)*)";
80              
81             # NNTP/news.
82             $group = "(?:$alpha\[-A-Za-z0-9.+_]*)";
83             $article = "(?:(?:[$unreserved_range;/?:&=]|$escape)+" .
84             '@' . "$host)";
85             $grouppart = "(?:[*]|$article|$group)"; # It's important that
86             # $article goes before
87             # $group.
88              
89             # WAIS.
90             $search = "(?:(?:[$unreserved_range;:\@&=]|$escape)*)";
91             $database = $uchars;
92             $wtype = $uchars;
93             $wpath = $uchars;
94              
95             # prospero
96             $psegment = "(?:(?:[$unreserved_range?:\@&=]|$escape)*)";
97             $fieldname = "(?:(?:[$unreserved_range?:\@&]|$escape)*)";
98             $fieldvalue = "(?:(?:[$unreserved_range?:\@&]|$escape)*)";
99             $fieldspec = "(?:;$fieldname=$fieldvalue)";
100             $ppath = "(?:$psegment(?:/$psegment)*)";
101              
102             #
103             # The various '(?:(?:[$unreserved_range ...]|$escape)*)' above need
104             # some loop unrolling to speed up the match.
105             #
106              
107             1;
108              
109             __END__