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