Generated: Mon Aug 16 14:14:40 2010 from test-url-uri.pl 2010/07/24 3 KB.
#!/usr/bin/perl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) sub url_parse($) { my ($url) = @_; my $post = ''; my $name = ''; my $dir = ''; my $ind = index($url,'#'); if ($ind > 0) { $post = substr($url,$ind); $url = substr($url,0,$ind); } if ($url =~ /\/$/) { $dir = $url; } else { ($name,$dir) = fileparse($url); if ( !($name =~ /\./) ) { # without an EXTENT, assume directory $dir .= $name.'/'; $name = ''; } } return $dir,$name,$post; } sub uri_parse($) { my ($uri) = @_; $uri =~ /^(([^:\/\?#]+):)?(\/\/([^\/\?#]*))?([^\?#]*)(\?([^#]*))?(#(.*))?/; # Then: my $scheme=$2; my $authority=$4; my $path=$5; my $query=$7; my $fragment=$9; return $scheme,$authority,$path,$query,$fragment; } sub uri_parse2($) { my ($uri) = shift; $uri =~ /^(([^:\/\?#]+):)?(\/\/([^\/\?#]*))?([^\?#]*)(\?([^#]*))?(#(.*))?/; # Then: my $scheme = (defined $2) ? $2 : ''; my $authority = (defined $4) ? $4 : ''; my $path = (defined $5) ? $5 : ''; my $query = (defined $7) ? $7 : ''; my $fragment = (defined $9) ? $9 : ''; return $scheme,$authority,$path,$query,$fragment; } my $href = 'http://abc.com/def.htm#offset'; my $href2 = 'https://abc.org/something%20'; my $ind = index($href,'#'); my $hr2 = substr($href,$ind); my $hrf = substr($href,0,$ind); print "Using index [$href] - [$hrf] + [$hr2]\n"; my ($nm,$dir) = fileparse($href); my $nm1 = ''; if ($nm =~ /#/) { $ind = index($nm,'#'); $nm1 = substr($nm,$ind); $nm = substr($nm,0,$ind); } print "Using parse [$href] = [$dir] + [$nm] + [$nm1]\n"; my ($nm2,$dir2) = fileparse($href2); print "[$href2] = [$dir2] + [$nm2]\n"; # =============================== my ($d,$n,$p) = url_parse($href); print "url_parse [$href] = [$d] + [$n] + [$p]\n"; ($d,$n,$p) = url_parse($href2); print "url_parse [$href2] = [$d] + [$n] + [$p]\n"; my ($sch,$auth,$path,$qery,$frag); ($sch,$auth,$path,$qery,$frag) = uri_parse($href); print "From [$href]\n"; print "Scheme : $sch\n" if (defined $sch); print "Authority: $auth\n" if (defined $auth); print "Path : $path\n" if (defined $path); print "Query : $qery\n" if (defined $qery); print "Fragment : $frag\n" if (defined $frag); ($sch,$auth,$path,$qery,$frag) = uri_parse($href2); print "From [$href2]\n"; print "Scheme : $sch\n" if (defined $sch); print "Authority: $auth\n" if (defined $auth); print "Path : $path\n" if (defined $path); print "Query : $qery\n" if (defined $qery); print "Fragment : $frag\n" if (defined $frag); ($sch,$auth,$path,$qery,$frag) = uri_parse2($href); print "From [$href] = [$sch],[$auth],[$path],[$qery],[$frag]\n"; ($sch,$auth,$path,$qery,$frag) = uri_parse2($href2); print "From [$href2] = [$sch],[$auth],[$path],[$qery],[$frag]\n";