1package URI::WithBase;
2
3use strict;
4use vars qw($AUTOLOAD $VERSION);
5use URI;
6
7$VERSION = "2.19";
8
9use overload '""' => "as_string", fallback => 1;
10
11sub as_string;  # help overload find it
12
13sub new
14{
15    my($class, $uri, $base) = @_;
16    my $ibase = $base;
17    if ($base && ref($base) && UNIVERSAL::isa($base, __PACKAGE__)) {
18	$base = $base->abs;
19	$ibase = $base->[0];
20    }
21    bless [URI->new($uri, $ibase), $base], $class;
22}
23
24sub new_abs
25{
26    my $class = shift;
27    my $self = $class->new(@_);
28    $self->abs;
29}
30
31sub _init
32{
33    my $class = shift;
34    my($str, $scheme) = @_;
35    bless [URI->new($str, $scheme), undef], $class;
36}
37
38sub eq
39{
40    my($self, $other) = @_;
41    $other = $other->[0] if UNIVERSAL::isa($other, __PACKAGE__);
42    $self->[0]->eq($other);
43}
44
45sub AUTOLOAD
46{
47    my $self = shift;
48    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
49    return if $method eq "DESTROY";
50    $self->[0]->$method(@_);
51}
52
53sub can {                                  # override UNIVERSAL::can
54    my $self = shift;
55    $self->SUPER::can(@_) || (
56      ref($self)
57      ? $self->[0]->can(@_)
58      : undef
59    )
60}
61
62sub base {
63    my $self = shift;
64    my $base  = $self->[1];
65
66    if (@_) { # set
67	my $new_base = shift;
68	# ensure absoluteness
69	$new_base = $new_base->abs if ref($new_base) && $new_base->isa(__PACKAGE__);
70	$self->[1] = $new_base;
71    }
72    return unless defined wantarray;
73
74    # The base attribute supports 'lazy' conversion from URL strings
75    # to URL objects. Strings may be stored but when a string is
76    # fetched it will automatically be converted to a URL object.
77    # The main benefit is to make it much cheaper to say:
78    #   URI::WithBase->new($random_url_string, 'http:')
79    if (defined($base) && !ref($base)) {
80	$base = ref($self)->new($base);
81	$self->[1] = $base unless @_;
82    }
83    $base;
84}
85
86sub clone
87{
88    my $self = shift;
89    my $base = $self->[1];
90    $base = $base->clone if ref($base);
91    bless [$self->[0]->clone, $base], ref($self);
92}
93
94sub abs
95{
96    my $self = shift;
97    my $base = shift || $self->base || return $self->clone;
98    $base = $base->as_string if ref($base);
99    bless [$self->[0]->abs($base, @_), $base], ref($self);
100}
101
102sub rel
103{
104    my $self = shift;
105    my $base = shift || $self->base || return $self->clone;
106    $base = $base->as_string if ref($base);
107    bless [$self->[0]->rel($base, @_), $base], ref($self);
108}
109
1101;
111
112__END__
113
114=head1 NAME
115
116URI::WithBase - URIs which remember their base
117
118=head1 SYNOPSIS
119
120 $u1 = URI::WithBase->new($str, $base);
121 $u2 = $u1->abs;
122
123 $base = $u1->base;
124 $u1->base( $new_base )
125
126=head1 DESCRIPTION
127
128This module provides the C<URI::WithBase> class.  Objects of this class
129are like C<URI> objects, but can keep their base too.  The base
130represents the context where this URI was found and can be used to
131absolutize or relativize the URI.  All the methods described in L<URI>
132are supported for C<URI::WithBase> objects.
133
134The methods provided in addition to or modified from those of C<URI> are:
135
136=over 4
137
138=item $uri = URI::WithBase->new($str, [$base])
139
140The constructor takes an optional base URI as the second argument.
141If provided, this argument initializes the base attribute.
142
143=item $uri->base( [$new_base] )
144
145Can be used to get or set the value of the base attribute.
146The return value, which is the old value, is a URI object or C<undef>.
147
148=item $uri->abs( [$base_uri] )
149
150The $base_uri argument is now made optional as the object carries its
151base with it.  A new object is returned even if $uri is already
152absolute (while plain URI objects simply return themselves in
153that case).
154
155=item $uri->rel( [$base_uri] )
156
157The $base_uri argument is now made optional as the object carries its
158base with it.  A new object is always returned.
159
160=back
161
162
163=head1 SEE ALSO
164
165L<URI>
166
167=head1 COPYRIGHT
168
169Copyright 1998-2002 Gisle Aas.
170
171=cut
172