#!/usr/bin/perl -w
#
# http :// www.oswego.edu /compsci/advisement/signup.cgi ? name=bill&major=isc
# |--| |---host-----| |---directory------| |--parameters-----|
# protocol |--------path----------------|
# |--------uri---------------------------------------|
#
use 5.004;
use strict;
use subs qw(
&proto
&site
&port
&uri
¶ms
&path
&file
&dir
);
use subs qw(
&proto_split
);
use vars qw(
$DEFAULT_HOST
$DEFAULT_PORT
$DEFAULT_PROTO
);
use vars qw(
$href
);
$DEFAULT_HOST = "cs.oswego.edu";
$DEFAULT_PORT = 80;
$DEFAULT_PROTO = "http";
sub proto_split
{
my $url = shift;
my $proto = &proto($url) || $DEFAULT_PROTO;
my $host = &site($url) || $DEFAULT_HOST;
my $port = &port($url) || $DEFAULT_PORT;
my $uri = &uri($url) || $url;
my $path = &path($url) || $url;
my $params = ¶ms($url); # || $url;
$params =~ s/^\?// if $params;
return ($proto, $host, $port, $uri, $path, $params);
}
sub proto
{
my $uri = shift;
if ($uri =~ /^([^:]+):(.*)$/) {
return $1;
} else {
return "";
}
}
sub site
{
my $uri = shift;
my $proto = &proto($uri);
if ($uri =~ /^\Q$proto\E\:\/\/([^\/\:]+)(.*)$/) {
return $1;
} else {
return "";
}
}
sub port
{
my $uri = shift;
my $proto = &proto($uri);
if ($uri =~ /^\Q$proto\E\:\/\/([^\/\:]+)\:(\d+)(.*)$/) {
return $2;
} else {
return 80;
}
}
sub uri
{
my $uri = shift;
my $proto = &proto($uri);
my $site = &site($uri);
my $port = &port($uri);
my $spec = $uri;
if ($uri =~ /^\Q$proto\E\:\/\/\Q$site\E\:\Q$port\E(.*)$/) {
$spec = $1;
} elsif ($uri =~ /^\Q$proto\E\:\/\/\Q$site\E(.*)$/) {
$spec = $1;
$spec = "/" if !$spec;
} else {
$spec = $uri;
}
return $spec;
}
sub file
{
my $url = shift;
my $path = &path($url);
if ($path =~ /^.*\/([^\/]+)$/) {
return $1;
} else {
return "index.html";
}
}
sub path
{
my $uri = &uri("@_");
if ($uri =~ /^([^?]+).*/) {
return $1;
} else {
return $uri;
}
}
sub dir
{
my $url = shift;
my $path = &path($url);
if ($path =~ /(^.*\/)([^\/]+)$/) {
return $1;
} else {
return "index.html";
}
}
sub params
{
my $url = shift;
my $uri = &uri($url);
my $path = &path($url);
if ($uri =~ /^\Q$path\E(.*)$/) {
return $1;
} else {
return "";
}
}
if ($#ARGV != 0) {
print STDERR "url missing\n";
exit 1;
}
$href = $ARGV[0];
my @msg = &proto_split($href);
my ($proto, $host, $port, $uri, $path, $params) =
&proto_split($href);
my $PARAMS = ($params ? $params : "NONE");
print STDOUT<<EOS;
Protocol is: $proto
Host is: $host
Port is: $port
URI is: $uri
PATH is: $path
PARAMS is: $PARAMS
EOS
exit 0;