Moved all specific scheme support to external files that are loaded

on demand.

lib/URI/URL/file.pm

@@ -0,0 +1,27 @@
+package URI::URL::file;
+@ISA = qw(URI::URL::_generic);
+
+# fileurl        = "file://" [ host | "localhost" ] "/" fpath
+# fpath          = fsegment *[ "/" fsegment ]
+# fsegment       = *[ uchar | "?" | ":" | "@" | "&" | "=" ]
+# Note that fsegment can contain '?' (query) but not ';' (param)
+
+sub _parse {
+    my($self, $init) = @_;
+    # allow the generic parser to do the bulk of the work
+    $self->URI::URL::_generic::_parse($init);
+    # then just deal with the effect of rare stray '?'s
+    if (defined $self->{'query'}){
+        $self->{'path'} .= '?' . $self->{'query'};
+        delete $self->{'query'};
+    }
+    1;
+}
+
+sub _esc_path
+{
+    my($self, $text) = @_;
+    $text =~ s/([^-a-zA-Z\d\$_.+!*'(),%?:@&=\/])/$URI::URL::escapes{$1}/oeg; #' fix emacs
+    $text;
+}
+1;

lib/URI/URL/finger.pm

@@ -0,0 +1,5 @@
+package URI::URL::finger;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 79 }
+1;

lib/URI/URL/ftp.pm

@@ -0,0 +1,36 @@
+package URI::URL::ftp;
+require URI::URL::file;
+@ISA = qw(URI::URL::file);
+
+sub default_port { 21 }
+
+sub user
+{
+    my($self, @val) = @_;
+    my $old = $self->URI::URL::_generic::user(@val);
+    defined $old ? $old : "anonymous";
+}
+
+BEGIN {
+    $whoami = undef;
+    $fqdn   = undef;
+}
+
+sub password
+{
+    my($self, @val) = @_;
+    my $old = $self->URI::URL::_generic::password(@val);
+    unless (defined $old) {
+	# anonymous ftp login password
+	unless (defined $fqdn) {
+	    require Sys::Hostname;
+	    $fqdn = Sys::Hostname::hostname();
+	}
+	unless (defined $whoami) {
+	    $whoami = $ENV{USER} || $ENV{LOGNAME} || `whoami`;
+	    chomp $whoami;
+	}
+	$old = "$whoami\@$fqdn";
+    }
+    $old;
+}

lib/URI/URL/gopher.pm

@@ -0,0 +1,59 @@
+package URI::URL::gopher;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 70 }
+
+sub _parse {
+    my($self, $url)   = @_;
+    $self->{scheme}   = lc($1) if $url =~ s/^\s*([\w\+\.\-]+)://;
+    $self->netloc($self->unescape($1)) if $url =~ s!^//([^/]*)!!;
+    $self->path($self->unescape($url));
+}
+
+sub path {
+    my($self, @val) = @_;
+    my $old = $self->URI::URL::_generic::path;
+    return $old unless @val;
+
+    my $val = $val[0];
+    $self->{'path'} = $val;
+
+    if ($val =~ s!^/(.)!!) {
+        $self->{'gtype'} = $1;
+    } else {
+        $self->{'gtype'} = "1";
+        $val = "";
+    }
+
+    delete $self->{'selector'};
+    delete $self->{'search'};
+    delete $self->{'string'};
+
+    my @parts = split(/\t/, $val, 3);
+    $self->{'selector'} = shift @parts if @parts;
+    $self->{'search'}   = shift @parts if @parts;
+    $self->{'string'}   = shift @parts if @parts;
+
+    $old;
+}
+
+sub gtype    { shift->_path_elem('gtype',    @_); }
+sub selector { shift->_path_elem('selector', @_); }
+sub search   { shift->_path_elem('search',   @_); }
+sub string   { shift->_path_elem('string',   @_); }
+
+sub _path_elem {
+    my($self, $elem, @val) = @_;
+    my $old = $self->_elem($elem, @val);
+    return $old unless @val;
+
+    # construct new path based on elements
+    my $path = "/$self->{'gtype'}";
+    $path .= "\t$self->{'selector'}" if defined $self->{'selector'};
+    $path .= "\t$self->{'search'}"   if defined $self->{'search'};
+    $path .= "\t$self->{'string'}"   if defined $self->{'string'};
+    $self->{'path'} = $path;
+
+    $old;
+}
+1;

lib/URI/URL/http.pm

@@ -0,0 +1,2 @@
+# Bundled with URI::URL;
+1;

lib/URI/URL/https.pm

@@ -0,0 +1,6 @@
+package URI::URL::https;
+require URI::URL::http;
+@ISA = qw(URI::URL::http);
+
+sub default_port { 443 }
+1;

lib/URI/URL/mailto.pm

@@ -0,0 +1,19 @@
+package URI::URL::mailto;
+@ISA = qw(URI::URL::_generic);
+
+sub _parse {
+    my($self, $init) = @_;
+    $self->{'scheme'}  = lc($1) if ($init =~ s/^\s*([\w\+\.\-]+)://);
+    $self->{'encoded822addr'} = $self->unescape($init);
+}
+
+sub encoded822addr { shift->_elem('encoded822addr', @_); }
+
+sub as_string {
+    my $self = shift;
+    my $str = '';
+    $str .= "$self->{'scheme'}:" if defined $self->{'scheme'};
+    $str .= "$self->{'encoded822addr'}" if defined $self->{'encoded822addr'};
+    $str;
+}
+1;

lib/URI/URL/news.pm

@@ -0,0 +1,15 @@
+package URI::URL::news;
+@ISA = qw(URI::URL::_generic);
+
+sub _parse {
+    my($self, $init) = @_;
+    $self->{scheme}  = lc($1) if ($init =~ s/^\s*([\w\+\.\-]+)://);
+    my $tmp = $self->unescape($init);
+    $self->{'grouppart'} = $tmp;
+    $self->{ ($tmp =~ m/\@/) ? 'article' : 'group' } = $tmp;
+}
+
+sub grouppart { shift->_elem('grouppart', @_) }
+sub article   { shift->_elem('article',   @_) }
+sub group     { shift->_elem('group',     @_) }
+1;

lib/URI/URL/nntp.pm

@@ -0,0 +1,16 @@
+package URI::URL::nntp;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 119 }
+
+sub _parse {
+    my($self, $init) = @_;
+    $self->URI::URL::_generic::_parse($init);
+    my @parts      = split(/\//, $self->{path});
+    $self->{'group'} = $self->unescape($parts[1]);
+    $self->{'digits'}= $self->unescape($parts[2]);
+}
+
+sub group  { shift->_elem('group',  @_); }
+sub digits { shift->_elem('digits', @_); }
+1;

lib/URI/URL/prospero.pm

@@ -0,0 +1,5 @@
+package URI::URL::prospero;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 1525 }       # says rfc1738, section 3.11
+1;

lib/URI/URL/rlogin.pm

@@ -0,0 +1,3 @@
+package URI::URL::rlogin;
+@ISA = qw(URI::URL::_generic);
+1;

lib/URI/URL/telnet.pm

@@ -0,0 +1,5 @@
+package URI::URL::telnet;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 23 }
+1;

lib/URI/URL/tn3270.pm

@@ -0,0 +1,3 @@
+package URI::URL::tn3270;
+@ISA = qw(URI::URL::_generic);
+1;

lib/URI/URL/wais.pm

@@ -0,0 +1,19 @@
+package URI::URL::wais;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 210 }
+
+sub _parse {
+    my($self, $init) = @_;
+    $self->URI::URL::_generic::_parse($init);
+    my @parts         = split(/\//, $self->{'path'});
+    $self->{'database'} = $self->unescape($parts[1]);
+    $self->{'wtype'}    = $self->unescape($parts[2]);
+    $self->{'wpath'}    = $self->unescape($parts[3]);
+}
+
+# Setting these should really update path
+sub database { shift->_elem('database', @_); }
+sub wtype    { shift->_elem('wtype',    @_); }
+sub wpath    { shift->_elem('wpath',    @_); }
+1;

lib/URI/URL/webster.pm

@@ -0,0 +1,5 @@
+package URI::URL::webster;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 765 }
+1;

lib/URI/URL/whois.pm

@@ -0,0 +1,5 @@
+package URI::URL::whois;
+@ISA = qw(URI::URL::_generic);
+
+sub default_port { 43 }
+1;