src/URL/URLhandler.pm

# Interface
# ---------
# new(cache)       : A new urlhandler with a defined default cahce directory
# download(url,[location]) : as get but always download
# 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(urlstring) : set a base url type - return the url object
# unsetbase(type)  : deactivate a previously set base
# currentbase(type) : return the current base for the given type
# expandurl(urlstring) : return the base expanded URLclass of the given string
#
# ----------------------------------------------------------------------

package URL::URLhandler;
require 5.004;
use Utilities::AddDir;
use URL::URLcache;
use URL::URLclass;
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->{cachestore}=$self->{cache}->filestore();
        use URL::URL_cvs;
        use URL::URL_file;
        use URL::URL_test;
        $self->{urlmodules}={
                        'cvs' => 'URL::URL_cvs',
                        'file' => 'URL::URL_file',
                        'test' => 'URL::URL_test'
                };
}

sub get
   {
   my $self=shift;
   my $origurl=shift;
   my $file="";
   
   my $url=URL::URLclass->new($origurl);
   my $type=$url->type();
   $url->merge($self->currentbase($type));
   my $fullurl=$url->url();
   
   $file=$self->{cache}->file($fullurl);
   if ( $file eq "" )
      {
      ($fullurl,$file)=$self->download($origurl, @_);
      if (-f $file)
         {
         my $filemode = 0644;   chmod $filemode, $file;
         }
      }
   return ($fullurl, $file);
   }

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

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

        # Generate a location name if not provided 
        my $nocache=1;
        if ( @_ ) {
           $location=shift;
           $nocache=0; # dont cache if downloaded to an external location
        }
        else {
           $location=$self->{cache}->filename($url->url());
        }
        # -- get the file from 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 ne "" ) {
         if ( $file && $nocache) {
          $self->{cache}->store($url->url(), $file);
         }
        }
        return ($url->url(), $file, $urltypehandler->error());
}

sub expandurl {
        my $self=shift;
        my $urlstring=shift;

        my $url=URL::URLclass->new($urlstring);
        my $type=$url->type();
        $url->merge($self->currentbase($type));
        return $url;
}

sub setbase {
        my $self=shift;
        my $partialurl=shift;

        my $base=URL::URLclass->new($partialurl);
        my $type=$base->type();
        $self->checktype($type);
        # make a new base-url object
        push @{$self->{"basestack"}{$type}}, $base;
        return $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=undef;
        }
        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 doesnt already exist;
        if ( exists $self->{'urlobjs'}{$type} ) {
                $self->{'urlobjs'}{$type};
        }       
        else {
                $self->{'urlobjs'}{$type}=$self->{urlmodules}{$type}->new();
        }
}
Revision:	1.18
Committed:	Wed Feb 2 20:16:46 2005 UTC (20 years, 3 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	v102p1, V1_0_1
Changes since 1.17:	+22 -16 lines
Log Message:	Some more tidying of file permissions for downloaded/cached files.
#	User	Rev	Content
1	williamc	1.7	# Interface
2	williamc	1.1	# ---------
3	williamc	1.7	# new(cache) : A new urlhandler with a defined default cahce directory
4	williamc	1.11	# download(url,[location]) : as get but always download
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.16	# setbase(urlstring) : set a base url type - return the url object
9	williamc	1.1	# unsetbase(type) : deactivate a previously set base
10	williamc	1.9	# currentbase(type) : return the current base for the given type
11	williamc	1.16	# expandurl(urlstring) : return the base expanded URLclass of the given string
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	williamc	1.1	use Carp;
21
22			sub new {
23			my $class=shift;
24			my $cache=shift;
25			$self={};
26			bless $self, $class;
27			$self->init($cache);
28			return $self;
29			}
30
31			sub init {
32			use Utilities::AddDir;
33			my $self=shift;
34			my $cache=shift;
35			$self->{cache}=$cache;
36	williamc	1.7	$self->{cachestore}=$self->{cache}->filestore();
37	williamc	1.2	use URL::URL_cvs;
38			use URL::URL_file;
39	williamc	1.13	use URL::URL_test;
40	williamc	1.2	$self->{urlmodules}={
41	williamc	1.5	'cvs' => 'URL::URL_cvs',
42	williamc	1.7	'file' => 'URL::URL_file',
43	williamc	1.13	'test' => 'URL::URL_test'
44	williamc	1.2	};
45	williamc	1.1	}
46
47	sashby	1.18	sub get
48			{
49			my $self=shift;
50			my $origurl=shift;
51			my $file="";
52
53			my $url=URL::URLclass->new($origurl);
54			my $type=$url->type();
55			$url->merge($self->currentbase($type));
56			my $fullurl=$url->url();
57
58			$file=$self->{cache}->file($fullurl);
59			if ( $file eq "" )
60			{
61			($fullurl,$file)=$self->download($origurl, @_);
62			if (-f $file)
63			{
64			my $filemode = 0644; chmod $filemode, $file;
65			}
66			}
67			return ($fullurl, $file);
68			}
69	williamc	1.11
70			sub download {
71			my $self=shift;
72			my $origurl=shift;
73
74			# Process the URL string
75			my $url=URL::URLclass->new($origurl);
76	williamc	1.9	my $type=$url->type();
77			$urltypehandler=$self->_typehandler($type);
78	williamc	1.15	$url->merge($self->currentbase($type));
79	williamc	1.9
80			# Generate a location name if not provided
81	williamc	1.16	my $nocache=1;
82	williamc	1.9	if ( @_ ) {
83			$location=shift;
84	williamc	1.12	$nocache=0; # dont cache if downloaded to an external location
85	williamc	1.9	}
86			else {
87			$location=$self->{cache}->filename($url->url());
88			}
89	williamc	1.11	# -- get the file from the appropriate handler
90	williamc	1.9	if ( defined $urltypehandler ) {
91			# Call the download module
92			$file=eval{$urltypehandler->get($url, $location)};
93			}
94	williamc	1.4
95	williamc	1.9	# now register it in the cache if successful
96	williamc	1.16	if ( $file ne "" ) {
97			if ( $file && $nocache) {
98			$self->{cache}->store($url->url(), $file);
99			}
100			}
101			return ($url->url(), $file, $urltypehandler->error());
102			}
103
104			sub expandurl {
105			my $self=shift;
106			my $urlstring=shift;
107
108			my $url=URL::URLclass->new($urlstring);
109			my $type=$url->type();
110			$url->merge($self->currentbase($type));
111			return $url;
112	williamc	1.4	}
113
114	williamc	1.9	sub setbase {
115	williamc	1.1	my $self=shift;
116	williamc	1.15	my $partialurl=shift;
117	williamc	1.7
118	williamc	1.15	my $base=URL::URLclass->new($partialurl);
119			my $type=$base->type();
120	williamc	1.9	$self->checktype($type);
121	williamc	1.15	# make a new base-url object
122	williamc	1.10	push @{$self->{"basestack"}{$type}}, $base;
123	williamc	1.16	return $base;
124	williamc	1.9	}
125	williamc	1.1
126	williamc	1.9	sub unsetbase {
127			my $self=shift;
128			my $type=shift;
129			my $oref;
130	williamc	1.7
131	williamc	1.9	$self->checktype($type);
132			# pop off the stack and call the unset base method
133			if ( $#{$self->{basestack}{$type}} >=0 ) {
134			my $base=pop @{$self->{basestack}{$type}};
135			undef $base;
136			}
137			else {
138			die "URLhandler error: Unable to unset type $type\n";
139	williamc	1.4	}
140	williamc	1.10	# remove the stack if its empty
141			if ( $#{$self->{basestack}{$type}} == -1 ) {
142			delete $self->{basestack}{$type};
143			}
144	williamc	1.1	}
145
146	williamc	1.9	sub currentbase {
147	williamc	1.1	my $self=shift;
148			my $type=shift;
149	williamc	1.9	my $rv;
150	williamc	1.1
151	williamc	1.9	if ( exists $self->{basestack}{$type} ) {
152	williamc	1.10	$rv=${$self->{basestack}{$type}}[$#{$self->{basestack}{$type}}];
153	williamc	1.1	}
154			else {
155	williamc	1.15	$rv=undef;
156	williamc	1.1	}
157	williamc	1.9	return $rv;
158	williamc	1.1	}
159
160	williamc	1.9	sub checktype($type) {
161	williamc	1.1	my $self=shift;
162	williamc	1.9	my $type=shift;
163	williamc	1.1
164	williamc	1.9	# Check type is supported
165	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
166	williamc	1.9	die "URLhandler error: Unsupported type $type\n";
167	williamc	1.1	}
168			}
169
170	williamc	1.9	sub _typehandler {
171	williamc	1.7	my $self=shift;
172	williamc	1.8	my $type=shift;
173	williamc	1.7
174	williamc	1.9	$self->checktype($type);
175	williamc	1.7
176	sashby	1.17	# instantiate only if it doesnt already exist;
177	williamc	1.10	if ( exists $self->{'urlobjs'}{$type} ) {
178			$self->{'urlobjs'}{$type};
179			}
180			else {
181			$self->{'urlobjs'}{$type}=$self->{urlmodules}{$type}->new();
182			}
183	williamc	1.1	}