Bjoern Hoehrmann <[EMAIL PROTECTED]> writes:
> I'll shout when it isn't sufficient :-)
This patch is needed to ensure that the $uri->host() method is not
confused by all the ':'s that might now be in the middle of the
hostname.
Index: URI/_server.pm
===================================================================
RCS file: /cvsroot/libwww-perl/uri/URI/_server.pm,v
retrieving revision 4.2
retrieving revision 4.3
diff -u -p -u -r4.2 -r4.3
--- URI/_server.pm 1998/10/12 12:03:13 4.2
+++ URI/_server.pm 2001/05/15 03:41:38 4.3
@@ -32,19 +32,20 @@ sub host
if (@_) {
my $tmp = $old;
$tmp = "" unless defined $tmp;
- my $ui;
- $ui = $1 if $tmp =~ s/^([^@]*@)//;
- $tmp =~ s/^[^:]*//; # get rid of old host
+ my $ui = ($tmp =~ /^([^@]*@)/) ? $1 : "";
+ my $port = ($tmp =~ /(:\d+)$/) ? $1 : "";
my $new = shift;
- if (defined $new) {
+ $new = "" unless defined $new;
+ if (length $new) {
$new =~ s/[@]/%40/g; # protect @
- $tmp = ($new =~ /:/) ? $new : "$new$tmp";
+ $port = $1 if $new =~ s/(:\d+)$//;
}
- $tmp = "$ui$tmp" if defined $ui;
- $self->authority($tmp);
+ $self->authority("$ui$new$port");
}
- return undef if !defined($old) || $old !~ /^(?:[^@]*@)?([^:]*)/;
- return uri_unescape($1);
+ return undef unless defined $old;
+ $old =~ s/^[^@]*@//;
+ $old =~ s/:\d+$//;
+ return uri_unescape($old);
}
sub _port
