1package Regexp::Common::URI::RFC1738;
2
3use Regexp::Common qw /pattern clean no_defaults/;
4
5use strict;
6use warnings;
7
8use vars qw /$VERSION/;
9$VERSION = '2017060201';
10
11use vars qw /@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA/;
12
13use Exporter ();
14@ISA = qw /Exporter/;
15
16
17my %vars;
18
19BEGIN {
20    $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    $vars {connect} = [qw /$port $hostnumber $toplabel $domainlabel $hostname
26                           $host $hostport $user $password $login/];
27
28    $vars {parts}   = [qw /$fsegment $fpath $group $article $grouppart
29                           $search $database $wtype $wpath $psegment
30                           $fieldname $fieldvalue $fieldspec $ppath/];
31}
32
33use vars map {@$_} values %vars;
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
1071;
108
109__END__
110
111=pod
112
113=head1 NAME
114
115Regexp::Common::URI::RFC1738 -- Definitions from RFC1738;
116
117=head1 SYNOPSIS
118
119    use Regexp::Common::URI::RFC1738 qw /:ALL/;
120
121=head1 DESCRIPTION
122
123This package exports definitions from RFC1738. It's intended
124usage is for Regexp::Common::URI submodules only. Its interface
125might change without notice.
126
127=head1 REFERENCES
128
129=over 4
130
131=item B<[RFC 1738]>
132
133Berners-Lee, Tim, Masinter, L., McCahill, M.: I<Uniform Resource
134Locators (URL)>. December 1994.
135
136=back
137
138=head1 AUTHOR
139
140Abigail S<(I<regexp-common@abigail.be>)>.
141
142=head1 BUGS AND IRRITATIONS
143
144Bound to be plenty.
145
146=head1 LICENSE and COPYRIGHT
147
148This software is Copyright (c) 2001 - 2017, Damian Conway and Abigail.
149
150This module is free software, and maybe used under any of the following
151licenses:
152
153 1) The Perl Artistic License.     See the file COPYRIGHT.AL.
154 2) The Perl Artistic License 2.0. See the file COPYRIGHT.AL2.
155 3) The BSD License.               See the file COPYRIGHT.BSD.
156 4) The MIT License.               See the file COPYRIGHT.MIT.
157
158=cut
159