Re: a patch for URI::URL 2.7 (?)
Tim Bunce (Tim.Bunce@ig.co.uk)
Tue, 9 May 1995 12:08:05 +0100
> From: Andreas Koenig <koenig@franz.ww.tu-berlin.de>
>
> I'd like to offer a patch for URI::URL. Please consider, if it's going
> the right direction, or if another approach was intended...
>
I've CC'd this to the libwww-perl list as they 'own' the URI::URL module.
> The problem I was facing was the second argument to new(). Here is a
> small example program that illustrates a "bug":
>
> > perl -Ilib2.7 -le '
> use URI::URL;
> $base=URI::URL->new("http://foo/root/dir/");
> $url=URI::URL->new("bar",$base);
> print "url->scheme: ", $url->scheme;
> print "url->netloc: ", $url->netloc;
> print "url->path: ", $url->path;
> print "url->port: ", $url->port;
> '
> url->scheme:
> url->netloc:
> url->path: bar
> url->port:
>
> After my patch the program says:
>
> url->scheme: http
> url->netloc: foo
> url->path: /root/dir/bar
> url->port: 80
I don't believe it's a bug. I think it's a feature.
> As you see, the new url didn't know much about the base url. The base
> url is currently just stored deep inside the new url object and *can*
> be accessed with the base() method. But it should IMO be actively
> transposed into the new object and could then even be forgotten (what
> my patch doesn't do).
Relative URL's, like yours, are very important. They must not simply
be made absolute by default.
You may get what you want by just saying:
$url = URI::URL->new("bar", $base);
$url = $url->abs; # make absolute using internal base url
> A fundamental problem I could not solve though: if the base url is a
> directory, but has no trailing "/", then the path for the child url is
> computed wrong. Is there a way to determine, if an url is a directory
> in the absence of a trailing slash?
That's an interesting question. What does $url = $url->abs; give you?
> The patch also addresses another problem: given an url without a port,
> say "http://foo/bar"; after making the url an object, the port()
> method does not respond with the default_url, it leaves the port
> unknown. I think I would prefer to get the default port whenever I ask
> the object for it's port.
Umm, now that I think is a bug.
> See the example:
>
> > perl -Ilib2.7 -le '
> use URI::URL; $url = URI::URL->new("http://foo/root/dir/");
> print "url->port: ", $url->port;
> '
> url->port:
>
> And this after my patch:
>
> url->port: 80
>
Yes the patch 'fixes' it but not in a manner consistent with the rest of the
module. I think a better fix for this problem is something like this:
*** URL.pm.27 Thu Apr 27 20:44:16 1995
--- URL.pm Tue May 9 12:03:49 1995
***************
*** 544,548 ****
sub password { shift->elem('password',@_); }
sub host { shift->elem('host', @_); }
! sub port { shift->elem('port', @_); }
# optimisation to speed up elem() below:
--- 544,557 ----
sub password { shift->elem('password',@_); }
sub host { shift->elem('host', @_); }
! sub port {
! my($self, $port) = @_;
! if (@_ > 1) { # set
! # if port is default then unset it (simplifies comparisons)
! $port = undef if ($port and $port == $self->default_port);
! return $self->elem('port', @_);
! }
! # get, return default if unset
! $self->elem('port') || $self->default_port;
! }
# optimisation to speed up elem() below:
Could someone (Martijn?) on libwww-perl integrate this?
Regards,
Tim.
> Here is the patch on top of gisle's 2.7 version, I hope it helps,
> andreas
>
>
>
> *** ../../lib2.7/URI/URL.pm Sun May 7 20:29:18 1995
> --- URL.pm Sun May 7 20:36:04 1995
> ***************
> *** 370,376 ****
> my $self;
> if (ref $init) {
> $self = $init->clone;
> - $self->base($base) if $base;
> } else {
> $init =~ s/^\s+//; # remove leading space
> $init =~ s/\s.*//; # remove anything after first word
> --- 370,375 ----
> ***************
> *** 398,403 ****
> --- 397,418 ----
> # hand-off to scheme specific implementation sub-class
> $self = $impclass->new($init, $base);
> }
> +
> + if ($base){
> + if (! ref $base){
> + $base = $class->new($base);
> + }
> + $self->base($base);
> +
> + $self->scheme($base->scheme) unless $self->scheme;
> + $self->netloc($base->netloc) unless $self->netloc;
> +
> + my($dir) = $base->path =~ m!(.*/)!;
> + $self->path($dir . $self->path) unless $self->path =~ m!^/!;
> + }
> +
> + $self->port($self->default_port) unless $self->port;
> +
> return $self;
> }
>
>
>
>
> END_OF_PATCH
>
>
>