test-url-uri.pl to HTML.

index -|- end

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";

index -|- top

checked by tidy  Valid HTML 4.01 Transitional