src/URL/URLhandler.pm

# url handler -> returns the location of the file
# Interface
# ---------
# new(cache)       : A new urlhandler with a defined default cahce directory
# get(url,[location]) : download from the specified url to cache or location
#                       return the full url path name incl. any base expansion
#                       and the filename downloaded to
# setbase(type,variablehash) : set the url defaults for a specific url type
#                              arguments are dependent on type
# unsetbase(type)  : deactivate a previously set base
# currentbase(type) : return the current base for the given type
#
# ----------------------------------------------------------------------

package URL::URLhandler;
require 5.004;
use Utilities::AddDir;
use URL::URLcache;
use URL::URLclass;
use URL::URLbase;
use Carp;

sub new {
        my $class=shift;
        my $cache=shift;
        $self={};
        bless $self, $class;
        $self->init($cache);
        return $self;
}

sub init {
        use Utilities::AddDir;
        my $self=shift;
        my $cache=shift;
        $self->{cache}=$cache;
        $self->{dummybase}=URL::URLbase->new({});
        $self->{cachestore}=$self->{cache}->filestore();
        use URL::URL_cvs;
        use URL::URL_cvsfile;
        use URL::URL_file;
        use URL::URL_filed;
        $self->{urlmodules}={
                        'cvsfile' => 'URL::URL_cvsfile',
                        'cvs' => 'URL::URL_cvs',
                        'file' => 'URL::URL_file',
                        'filed' => 'URL::URL_filed'
                };
}

sub get {
        my $self=shift;
        my $origurl=shift;

        # Process the URL string
        $url=URL::URLclass->new($origurl);
        my $type=$url->type();
        $urltypehandler=$self->_typehandler($type);
        $url->expandurl($self->currentbase($type));

        # Generate a location name if not provided 
        if ( @_ ) {
           $location=shift;
        }
        else {
           $location=$self->{cache}->filename($url->url());
        }
        # -- get the file form the appropriate handler
        if ( defined $urltypehandler ) {
             # Call the download module
             $file=eval{$urltypehandler->get($url, $location)}; 
        } 

        # now register it in the cache if successful
        if ( $file ) {
          $self->{cache}->store($url->url(), $file);
        }
        return ($url->url(), $file);
}

sub setbase {
        my $self=shift;
        my $type=shift;
        my @args=@_;
        my $oref;

        $self->checktype($type);
        # make a new base object
        my $base=URL::URLbase->new(@_);
        push @{$self->{"basestack"}{$type}}, $base;
}

sub unsetbase {
        my $self=shift;
        my $type=shift;
        my $oref;

        $self->checktype($type);
        # pop off the stack and call the unset base method
        if ( $#{$self->{basestack}{$type}} >=0 ) {
           my $base=pop @{$self->{basestack}{$type}};
           undef $base;
        }
        else {
           die "URLhandler error: Unable to unset type $type\n";
        }
        # remove the stack if its empty
        if ( $#{$self->{basestack}{$type}} == -1 ) {
          delete $self->{basestack}{$type};
        }
}

sub currentbase {
        my $self=shift;
        my $type=shift;
        my $rv;

        if ( exists $self->{basestack}{$type} ) {
          $rv=${$self->{basestack}{$type}}[$#{$self->{basestack}{$type}}];
        }
        else {
          $rv=$self->{dummybase};
        }
        return $rv;
}

sub checktype($type) {
        my $self=shift;
        my $type=shift;

        # Check type is supported
        if ( ! exists $self->{urlmodules}{$type} ) {
          die "URLhandler error: Unsupported type $type\n";
        }
}

sub _typehandler {
        my $self=shift;
        my $type=shift;

        $self->checktype($type);

        # instantiate only if it dosnt already exist;
        if ( exists $self->{'urlobjs'}{$type} ) {
                $self->{'urlobjs'}{$type};
        }       
        else {
                $self->{'urlobjs'}{$type}=$self->{urlmodules}{$type}->new();
        }
}
Revision:	1.10
Committed:	Mon Nov 15 16:50:00 1999 UTC (25 years, 5 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.9:	+14 -13 lines
Log Message:	Portability tests + base checking + get check OK
#	User	Rev	Content
1	williamc	1.7	# url handler -> returns the location of the file
2			# Interface
3	williamc	1.1	# ---------
4	williamc	1.7	# new(cache) : A new urlhandler with a defined default cahce directory
5	williamc	1.9	# get(url,[location]) : download from the specified url to cache or location
6			# return the full url path name incl. any base expansion
7			# and the filename downloaded to
8	williamc	1.4	# setbase(type,variablehash) : set the url defaults for a specific url type
9	williamc	1.7	# arguments are dependent on type
10	williamc	1.1	# unsetbase(type) : deactivate a previously set base
11	williamc	1.9	# currentbase(type) : return the current base for the given type
12	williamc	1.1	#
13			# ----------------------------------------------------------------------
14
15	williamc	1.5	package URL::URLhandler;
16	williamc	1.1	require 5.004;
17			use Utilities::AddDir;
18	williamc	1.9	use URL::URLcache;
19			use URL::URLclass;
20			use URL::URLbase;
21	williamc	1.1	use Carp;
22
23			sub new {
24			my $class=shift;
25			my $cache=shift;
26			$self={};
27			bless $self, $class;
28			$self->init($cache);
29			return $self;
30			}
31
32			sub init {
33			use Utilities::AddDir;
34			my $self=shift;
35			my $cache=shift;
36			$self->{cache}=$cache;
37	williamc	1.9	$self->{dummybase}=URL::URLbase->new({});
38	williamc	1.7	$self->{cachestore}=$self->{cache}->filestore();
39	williamc	1.2	use URL::URL_cvs;
40	williamc	1.5	use URL::URL_cvsfile;
41	williamc	1.2	use URL::URL_file;
42	williamc	1.7	use URL::URL_filed;
43	williamc	1.2	$self->{urlmodules}={
44	williamc	1.5	'cvsfile' => 'URL::URL_cvsfile',
45			'cvs' => 'URL::URL_cvs',
46	williamc	1.7	'file' => 'URL::URL_file',
47			'filed' => 'URL::URL_filed'
48	williamc	1.2	};
49	williamc	1.1	}
50
51	williamc	1.7	sub get {
52	williamc	1.4	my $self=shift;
53	williamc	1.9	my $origurl=shift;
54
55			# Process the URL string
56			$url=URL::URLclass->new($origurl);
57			my $type=$url->type();
58			$urltypehandler=$self->_typehandler($type);
59			$url->expandurl($self->currentbase($type));
60
61			# Generate a location name if not provided
62			if ( @_ ) {
63			$location=shift;
64			}
65			else {
66			$location=$self->{cache}->filename($url->url());
67			}
68			# -- get the file form the appropriate handler
69			if ( defined $urltypehandler ) {
70			# Call the download module
71			$file=eval{$urltypehandler->get($url, $location)};
72			}
73	williamc	1.4
74	williamc	1.9	# now register it in the cache if successful
75			if ( $file ) {
76	williamc	1.10	$self->{cache}->store($url->url(), $file);
77	williamc	1.9	}
78	williamc	1.10	return ($url->url(), $file);
79	williamc	1.4	}
80
81	williamc	1.9	sub setbase {
82	williamc	1.1	my $self=shift;
83	williamc	1.9	my $type=shift;
84			my @args=@_;
85			my $oref;
86	williamc	1.7
87	williamc	1.9	$self->checktype($type);
88			# make a new base object
89			my $base=URL::URLbase->new(@_);
90	williamc	1.10	push @{$self->{"basestack"}{$type}}, $base;
91	williamc	1.9	}
92	williamc	1.1
93	williamc	1.9	sub unsetbase {
94			my $self=shift;
95			my $type=shift;
96			my $oref;
97	williamc	1.7
98	williamc	1.9	$self->checktype($type);
99			# pop off the stack and call the unset base method
100			if ( $#{$self->{basestack}{$type}} >=0 ) {
101			my $base=pop @{$self->{basestack}{$type}};
102			undef $base;
103			}
104			else {
105			die "URLhandler error: Unable to unset type $type\n";
106	williamc	1.4	}
107	williamc	1.10	# remove the stack if its empty
108			if ( $#{$self->{basestack}{$type}} == -1 ) {
109			delete $self->{basestack}{$type};
110			}
111	williamc	1.1	}
112
113	williamc	1.9	sub currentbase {
114	williamc	1.1	my $self=shift;
115			my $type=shift;
116	williamc	1.9	my $rv;
117	williamc	1.1
118	williamc	1.9	if ( exists $self->{basestack}{$type} ) {
119	williamc	1.10	$rv=${$self->{basestack}{$type}}[$#{$self->{basestack}{$type}}];
120	williamc	1.1	}
121			else {
122	williamc	1.9	$rv=$self->{dummybase};
123	williamc	1.1	}
124	williamc	1.9	return $rv;
125	williamc	1.1	}
126
127	williamc	1.9	sub checktype($type) {
128	williamc	1.1	my $self=shift;
129	williamc	1.9	my $type=shift;
130	williamc	1.1
131	williamc	1.9	# Check type is supported
132	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
133	williamc	1.9	die "URLhandler error: Unsupported type $type\n";
134	williamc	1.1	}
135			}
136
137	williamc	1.9	sub _typehandler {
138	williamc	1.7	my $self=shift;
139	williamc	1.8	my $type=shift;
140	williamc	1.7
141	williamc	1.9	$self->checktype($type);
142	williamc	1.7
143	williamc	1.9	# instantiate only if it dosnt already exist;
144	williamc	1.10	if ( exists $self->{'urlobjs'}{$type} ) {
145			$self->{'urlobjs'}{$type};
146			}
147			else {
148			$self->{'urlobjs'}{$type}=$self->{urlmodules}{$type}->new();
149			}
150	williamc	1.1	}