home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 2000 April / VPR0004A.BIN / OLS / HTMLLINT / htmllint.lzh / RFC2396.pm < prev    next >
Text File  |  1999-12-15  |  14KB  |  288 lines

  1. # RFC2396.pm - Syntax for URI (RFC2396/RFC2368/RFC1738/RFC822)
  2. #
  3. #    0.0  1998/10/03
  4. #    0.1  1999/01/19
  5. #    0.2  1999/03/04 RFC2368
  6. #    0.3  1999/07/24 fixed(?) bug in mailto:
  7. #    0.40 1999/08/28 tune up regex / use Exporter / expire parse_URI
  8. #    0.41 1999/12/05 fixed(?) bug in URL_mailto
  9. #    0.42 1999/12/12 use Email:Valid
  10. #
  11. # by ISHINO Keiichiro <k16@softvision.co.jp>
  12.  
  13. package RFC2396;
  14. require 5.002;
  15.  
  16. BEGIN {
  17.   use Exporter;
  18.   @ISA       = qw(Exporter);
  19.   @EXPORT    = qw($URI_reference &URI_reference
  20.                   $URI_parsing
  21.                   $URL_ftp       &URL_ftp
  22.                   $URL_file      &URL_file
  23.                   $URL_http      &URL_http
  24.                   $URL_gopher    &URL_gopher
  25.                   $URL_mailto    &URL_mailto
  26.                   $URL_news      &URL_news
  27.                   $URL_nntp      &URL_nntp
  28.                   $URL_telnet    &URL_telnet
  29.                   $URL_wais      &URL_wais
  30.                   $URL_prospero  &URL_prospero
  31.                   );
  32. }
  33.  
  34. $VERSION = '0.42';
  35.  
  36. #$lowalpha     = '[a-z]';
  37. #$upalpha      = '[A-Z]';
  38. $_digit        = '0-9';             # char class
  39. $_alpha        = 'A-Za-z';          # char class
  40. $_alphanum     = $_digit.$_alpha;   # char class
  41. $digit         = '['.$_digit.']';
  42. $alpha         = '['.$_alpha.']';
  43. $alphanum      = '['.$_alphanum.']';
  44.  
  45. $hex           = '[0-9A-Fa-f]';
  46. $hex2          = $hex.$hex;
  47. $escaped       = '\%'.$hex2;
  48.  
  49. $control       = '[^\x20-\x7E]';
  50. $_space        = '\x20';            # char class
  51. $_delim        = '<>#%"';           # char class
  52. $_unwise       = '{}|\x5C^\[\]`';   # char class
  53. $spdelimunwise = '['.$_space.$_delim.$_unwise.']';
  54. $delimunwise   = '['.$_delim.$_unwise.']';
  55.  
  56. $_mark         = '\-_.!~*\'()';     # char class
  57. $_unreserved   = $_alphanum.$_mark; # char class
  58. $_reserved     = ';/?:@&=+$,';      # char class
  59. $uric          = '(?:['.$_unreserved.$_reserved.']|'.$escaped.')';
  60. $uric_no_slash = '(?:['.$_unreserved.';?:@&=+$,]|'.$escaped.')';
  61.  
  62. $fragment      = $uric.'*';
  63. $query         = $uric.'*';
  64.  
  65. $pchar         = '(?:['.$_unreserved.':@&=+$,]|'.$escaped.')';
  66. $param         = $pchar.'+';
  67. $segment       = '(?:'.$pchar.'+(?:;'.$param.')*|(?:;'.$param.')+)';
  68. $path_segments = $segment.'(?:/(?:'.$segment.')?)*';
  69. $rel_segment   = '(?:['.$_unreserved.';@&=+$,]|'.$escaped.')+';
  70.  
  71. $IPv4part      = '(?:[01]?\d\d?|2[0-4]\d|25[0-5])';
  72. $IPv4address   = $IPv4part.'\.'.$IPv4part.'\.'.$IPv4part.'\.'.$IPv4part;
  73. $toplabel      = $alpha.'(?:['.$_alphanum.'\-]*'.$alphanum.')?';
  74. $domainlabel   = $alphanum.'(?:['.$_alphanum.'\-]*'.$alphanum.')?';
  75. $hostname      = '(?:'.$domainlabel.'\.)*(?:'.$toplabel.')\.?';
  76. $host          = $hostname.'|'.$IPv4address;
  77. $port          = $digit.'*';
  78. $hostport      = '(?:'.$host.')(?::'.$port.')?';
  79.  
  80. $reg_name      = '(?:['.$_unreserved.';:@&=+$,]|'.$escaped.')+';
  81. $userinfo      = '(?:['.$_unreserved.';:&=+$,]|'.$escaped.')+';
  82. $server        = '(?:'.$userinfo.'\@)?'.$hostport;
  83. $authority     = '(?:'.$server.'|'.$reg_name.')';
  84.  
  85. $scheme        = $alpha.'['.$_alphanum.'+\-.]*';
  86.  
  87. $abs_path      = '/(?:'.$path_segments.')?';
  88. $net_path      = '//(?:'.$authority.'(?:'.$abs_path.')?|'.$abs_path.')';
  89. $rel_path      = $rel_segment.'(?:'.$abs_path.')?';
  90.  
  91. $hier_part     = '(?:'.$net_path.'|'.$abs_path.')(?:\?'.$query.')?';
  92. $opaque_part   = $uric_no_slash.$uric.'*';
  93.  
  94. $absoluteURI   = '(?:'.$scheme.':(?:'.$hier_part.'|'.$opaque_part.'))';
  95. $relativeURI   = '(?:'.$net_path.'|'.$abs_path.'|'.$rel_path.')(?:\?'.$query.')?';
  96.  
  97. $URI_reference = '(?:(?:'.$absoluteURI.'|'.$relativeURI.')(?:\#'.$fragment.')?|'.
  98.                                                             '\#'.$fragment.')';
  99. sub URI_reference { $_[0] =~ /^$URI_reference$/o; }
  100.  
  101. # RFC2396 Appendix B
  102. $URI_parsing = '(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?';
  103.  
  104.  
  105. ##############
  106.  
  107. # FTP (see also RFC959)
  108. $ftptype       = '[AIDaid]';
  109. $fsegment      = '(?:['.$_unreserved.'?:@&=+$,]|'.$escaped.')*';
  110. $fpath         = $fsegment.'(?:/'.$fsegment.')*';
  111. $password      = $userinfo;
  112. $login         = '(?:'.$userinfo.'(?::'.$password.')?\@)?'.$hostport;
  113. $URL_ftp       = 'ftp://'.$login.'(?:/'.$fpath.'(?:;type='.$ftptype.')?)?';
  114. sub URL_ftp { $_[0] =~ /^$URL_ftp$/o; }
  115.  
  116. # FILE (see also RFC1738)
  117. $URL_file      = 'file://(?:'. $host.'|localhost)?/'.$fpath;
  118. sub URL_file { $_[0] =~ /^$URL_file$/o; }
  119.  
  120. # HTTP (see also RFC1738)
  121. $hsegment      = '(?:['.$_unreserved.';:@&=+$,]|'.$escaped.')*';
  122. $hpath         = $hsegment.'(?:/'.$hsegment.')*';
  123. $URL_http      = 'https?://'.$hostport.'(?:/'.$hpath.'(?:\?'.$query.')?)?';
  124. sub URL_http { $_[0] =~ /^$URL_http$/o; }
  125.  
  126. # GOPHER (see also RFC1436)
  127. $gopher_string = $uric.'*';
  128. $selector      = $uric.'*';
  129. $gtype         = $uric;
  130. $URL_gopher    = 'gopher://'.$hostport.'(?:/(?:'.$gtype.'(?:'.$selector.
  131.                  '(?:\t'.$query.'(?:\t'.$gopher_string.')?)?)?)?)?';
  132. sub URL_gopher { $_[0] =~ /^$URL_gopher$/o; }
  133.  
  134. # MAILTO (see also RFC822/RFC2368)
  135. $_urlc         = $_unreserved.';/:@+$,'; # char class
  136. $urlc          = '(?:['.$_urlc.']|'.$escaped.')';
  137. $hname         = $urlc.'*';
  138. $hvalue        = $urlc.'*';
  139. $header        = $hname.'='.$hvalue;
  140. $headers       = '(\?'.$header.'(?:&'.$header.')*)?';
  141. $to            = '('.$urlc.'*)';
  142. $URL_mailto    = 'mailto:'.$to.$headers;
  143.  
  144. # Regular expression built using Jeffrey Friedl's example in
  145. # _Mastering Regular Expressions_ (http://www.ora.com/catalog/regexp/).
  146. $RFC822PAT = <<'EOF';
  147. [\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\
  148. xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xf
  149. f\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\x
  150. ff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015
  151. "]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\
  152. xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80
  153. -\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*
  154. )*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\
  155. \\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\
  156. x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x8
  157. 0-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n
  158. \015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x
  159. 80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
  160. \x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
  161. \t]*)*)*@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([
  162. ^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\
  163. \\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\
  164. x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
  165. \xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()
  166. ]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\
  167. x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\04
  168. 0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\
  169. n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\
  170. 015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?!
  171. [^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
  172. ]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\
  173. x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01
  174. 5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>@,;:".
  175. \\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
  176. )|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^
  177. ()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\0
  178. 15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][
  179. ^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\
  180. n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\\[\]\
  181. x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?
  182. :(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-
  183. \xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:@[\040\t]*
  184. (?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015
  185. ()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()
  186. ]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\0
  187. 40)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\
  188. [^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\
  189. xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*
  190. )*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80
  191. -\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x
  192. 80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t
  193. ]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\
  194. \[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])
  195. *\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x
  196. 80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80
  197. -\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\n\015(
  198. )]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\
  199. \x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*@[\040\t
  200. ]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\0
  201. 15()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015
  202. ()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(
  203. \040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|
  204. \\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80
  205. -\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()
  206. ]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x
  207. 80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
  208. \x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
  209. \t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".
  210. \\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
  211. ])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\
  212. \x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
  213. 80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n\015
  214. ()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\
  215. \\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)?(?:[^
  216. (\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-
  217. \037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\
  218. n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|
  219. \([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))
  220. [^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff
  221. \n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
  222. ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(
  223. ?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\
  224. 000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\
  225. xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\x
  226. ff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)
  227. *\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*@[\040\t]*(?:\([^\\\x80-\x
  228. ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-
  229. \xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)
  230. *(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\
  231. ]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]
  232. )[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-
  233. \xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\x
  234. ff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(
  235. ?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80
  236. -\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<
  237. >@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x8
  238. 0-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:
  239. \([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]
  240. *(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)
  241. *\)[\040\t]*)*)*>)
  242. EOF
  243. $RFC822PAT =~ s/\n//g;
  244.  
  245. sub URL_mailto {
  246.   unless ($_[0] =~ /^$URL_mailto$/o) { return 0; }
  247.   my ($to, $headers) = ($1, $2);
  248.   if ($to eq '') { return $headers ne ''; }
  249.   $to =~ s/\%($hex2)/chr(hex($1))/oge;
  250.   $to =~ /^$RFC822PAT$/o;
  251. }
  252.  
  253. # NEWS (see also RFC1036)
  254. $article       = '(?:['.$_unreserved.';/?:&=+$,]|'.$escaped.')+\@'.$domain;
  255. $newsgroup     = '(?:'.$alpha.'['.$_alphanum.'\-.+_]*)';
  256. $grouppart     = '(?:\*|'.$newsgroup.'|'.$article.')';
  257. $URL_news      = 'news:'.$grouppart;
  258. sub URL_news { $_[0] =~ /^$URL_news$/o; }
  259.  
  260. # NNTP (see also RFC977)
  261. $URL_nntp      = 'nntp://'.$hostport.'/'.$newsgroup.'(?:/'.$digit.'+)?';
  262. sub URL_nntp { $_[0] =~ /^$URL_nntp$/o; }
  263.  
  264. # TELNET (see also RFC1738)
  265. $URL_telnet    = 'telnet://'.$login.'/?';
  266. sub URL_telnet { $_[0] =~ /^$URL_telnet$/o; }
  267.  
  268. # WAIS (see also RFC1625)
  269. $wpath         = '(?:['.$_unreserved.'+$,]|'.$escaped.')*';
  270. $wtype         = '(?:['.$_unreserved.'+$,]|'.$escaped.')*';
  271. $database      = '(?:['.$_unreserved.'+$,]|'.$escaped.')*';
  272. $waisdoc       = $database.'/'.$wtype.'/'.$wpath;
  273. $waisindex     = $database.'\?'.$query;
  274. $waisdatabase  = $database;
  275. $URL_wais      = 'wais://'.$hostport.'/(?:'.$waisdatabase.'|'.$waisindex.'|'.$waisdoc.')';
  276. sub URL_wais { $_[0] =~ /^$URL_wais$/o; }
  277.  
  278. # PROSPERO (see also RFC1738)
  279. $fieldvalue    = '(?:['.$_unreserved.'?:@&+$,]|'.$escaped.')*';
  280. $fieldname     = '(?:['.$_unreserved.'?:@&+$,]|'.$escaped.')*';
  281. $fieldspec     = ';'.$fieldname.'='.$fieldvalue;
  282. $psegment      = '(?:['.$_unreserved.'?:@&=+$,]|'.$escaped.')*';
  283. $ppath         = $psegment.'(?:/'.$psegment.')*';
  284. $URL_prospero  = 'prospero://'.$hostport.'/'.$ppath.'(?:'.$fieldspec.')*';
  285. sub URL_prospero { $_[0] =~ /^$URL_prospero$/o; }
  286.  
  287. 1;
  288.