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)         : download from the specified url to the default cache
# getto(url,dirlocation): download to the specified directory - no cache registry
# setbase(type,variablehash) : set the url defaults for a specific url type
#                              arguments are dependent on type
# unsetbase(type)  : deactivate a previously set base
#
# ----------------------------------------------------------------------
# returns file location - or crashes out
# can pass a file name for the item to be stored as 
# if not then stores in a default cache.

package URL::URLhandler;
require 5.004;
use Utilities::AddDir;
use URL::URLUtilities;
use URL::URL_base;
use Carp;

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

sub init {
        use URL::URLcache;
        use Utilities::AddDir;
        my $self=shift;
        my $cache=shift;
        $self->{cache}=$cache;
        $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'
                };
        $self->{filebase}="";
        $self->setbase("file", {}); # Base file as default
        $self->setbase("filed", {}); # Base file as default
}

# 
sub get {
        my $self=shift;
        my $url=shift;


        my ($urlstring, $type, $urltypehandler, $base, $version)
                       =$self->_parseurl($url); # get a unique url string
        my $rv="";
        $rv=$self->getto($url,$self->{cache}->filename($urlstring));
        
        # now register it in the cache if successful
        if ( $rv ne "" ) {
          print "Storing ".$urlstring.",".$rv."\n";
          $self->{cache}->store($urlstring, $rv);
        }
        return $rv;
}

sub getto ($@) {
        my $self=shift;
        my $origurl=shift;
        my $dirname=shift;

        my $rest;
        my $type;
        my $version;
        my $rv="";

        # Process the URL string
        my ($urlstring, $type, $urltypehandler, $base, $version)
                                        =$self->_parseurl($origurl);

        if ( defined $urltypehandler ) {
             # Call the download module
             $rv=eval{$urltypehandler->get($base.(($version ne "")?"\?".$version:""), $dirname); };
        }

        # Check the return type
        if ( defined $rv ) {
        #  if ( $rv!~/^\// ) {
        #       $rv=$dirname."/".$rv;
        #  }
        }
        return $rv;
}

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

        # Check type is supported
        if ( ! exists $self->{urlmodules}{$type} ) {
          print "URLhandler error: Unsupported type $type\n";
          return 1;
        }
        else {
          # A new URL object - pushed onto the stack
          $oref=eval{$self->{urlmodules}{$type}}->new();
          push @{$self->{urlostack}{$type}}, $oref;
          $oref->setbase(@args);
        }
}

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

        # Check type is supported
        if ( ! exists $self->{urlmodules}{$type} ) {
          print "URLhandler error: Unsupported type $type\n";
          return 1;
        }
        else {
          # pop off the stack and call the unset base method
          if ( $#{$self->{urlostack}{$type}} >=0 ) {
            $oref=pop @{$self->{urlostack}{$type}};
            $oref->unsetbase();
            undef $oref;
          }
          else {
           print "URLhandler error: Unable to unset type $type\n";
           return 1;
          }
        }
}

# -------------------- Support Routines (private Methods) -------------

#
# Process the URL string into its component parts
#
sub _parseurl {
        my $self=shift;
        my $origurl=shift;
        chomp $origurl;

        my ($type,$rest,$cmdstring)=URLUtilities::parseURL($origurl);
        my $urlstring="";
        my $url;
        
        $base="";

        # check type are supported
        if ( ! ( exists $self->{'urlmodules'}{$type}) ) {
           print "URLhandler: Unsupported type $type\n";
           die;
        }
        else {
           if ( $#{$self->{urlostack}{$type}} < 0 ) {
             print "URLhandler : base not set for type $type \n";
             die;
           }
           else {
             # ---- type is supported 
             $urltypehandler=
                ${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}];
             $base=$urltypehandler->baseurl();
           }
        }

        my $urlbase=($base ne ""?$base."/":"").$rest;
        $urlstring=$type.":".$urlbase.($cmdstring ne ""?"?".$cmdstring:"");
        return $urlstring, $type, $urltypehandler, $urlbase, $cmdstring;
}
Revision:	1.7
Committed:	Thu Nov 4 10:08:33 1999 UTC (25 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.6:	+79 -54 lines
Log Message:	New interface and use of cache
#	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			# get(url) : download from the specified url to the default cache
6			# getto(url,dirlocation): download to the specified directory - no cache registry
7	williamc	1.4	# setbase(type,variablehash) : set the url defaults for a specific url type
8	williamc	1.7	# arguments are dependent on type
9	williamc	1.1	# unsetbase(type) : deactivate a previously set base
10			#
11			# ----------------------------------------------------------------------
12			# returns file location - or crashes out
13			# can pass a file name for the item to be stored as
14			# if not then stores in a default cache.
15
16	williamc	1.5	package URL::URLhandler;
17	williamc	1.1	require 5.004;
18			use Utilities::AddDir;
19	williamc	1.7	use URL::URLUtilities;
20	williamc	1.3	use URL::URL_base;
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	williamc	1.7	use URL::URLcache;
34	williamc	1.1	use Utilities::AddDir;
35			my $self=shift;
36			my $cache=shift;
37			$self->{cache}=$cache;
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	$self->{filebase}="";
50	williamc	1.2	$self->setbase("file", {}); # Base file as default
51	williamc	1.7	$self->setbase("filed", {}); # Base file as default
52	williamc	1.1	}
53
54	williamc	1.7	#
55			sub get {
56	williamc	1.4	my $self=shift;
57	williamc	1.7	my $url=shift;
58
59	williamc	1.4
60	williamc	1.7	my ($urlstring, $type, $urltypehandler, $base, $version)
61			=$self->_parseurl($url); # get a unique url string
62			my $rv="";
63			$rv=$self->getto($url,$self->{cache}->filename($urlstring));
64
65			# now register it in the cache if successful
66			if ( $rv ne "" ) {
67			print "Storing ".$urlstring.",".$rv."\n";
68			$self->{cache}->store($urlstring, $rv);
69			}
70			return $rv;
71	williamc	1.4	}
72
73	williamc	1.7	sub getto ($@) {
74	williamc	1.1	my $self=shift;
75			my $origurl=shift;
76	williamc	1.3	my $dirname=shift;
77	williamc	1.7
78	williamc	1.1	my $rest;
79			my $type;
80			my $version;
81	williamc	1.4	my $rv="";
82	williamc	1.1
83	williamc	1.7	# Process the URL string
84			my ($urlstring, $type, $urltypehandler, $base, $version)
85			=$self->_parseurl($origurl);
86
87			if ( defined $urltypehandler ) {
88			# Call the download module
89			$rv=eval{$urltypehandler->get($base.(($version ne "")?"\?".$version:""), $dirname); };
90	williamc	1.1	}
91	williamc	1.7
92			# Check the return type
93			if ( defined $rv ) {
94			# if ( $rv!~/^\// ) {
95			# $rv=$dirname."/".$rv;
96			# }
97	williamc	1.4	}
98			return $rv;
99	williamc	1.1	}
100
101			sub setbase {
102			my $self=shift;
103			my $type=shift;
104			my @args=@_;
105	williamc	1.2	my $oref;
106	williamc	1.1
107			# Check type is supported
108	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
109	williamc	1.1	print "URLhandler error: Unsupported type $type\n";
110			return 1;
111			}
112			else {
113	williamc	1.2	# A new URL object - pushed onto the stack
114			$oref=eval{$self->{urlmodules}{$type}}->new();
115			push @{$self->{urlostack}{$type}}, $oref;
116			$oref->setbase(@args);
117	williamc	1.1	}
118			}
119
120			sub unsetbase {
121			my $self=shift;
122			my $type=shift;
123	williamc	1.2	my $oref;
124	williamc	1.1
125			# Check type is supported
126	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
127	williamc	1.1	print "URLhandler error: Unsupported type $type\n";
128			return 1;
129			}
130			else {
131	williamc	1.2	# pop off the stack and call the unset base method
132			if ( $#{$self->{urlostack}{$type}} >=0 ) {
133			$oref=pop @{$self->{urlostack}{$type}};
134			$oref->unsetbase();
135			undef $oref;
136	williamc	1.1	}
137	williamc	1.2	else {
138			print "URLhandler error: Unable to unset type $type\n";
139			return 1;
140	williamc	1.1	}
141			}
142			}
143
144	williamc	1.7	# -------------------- Support Routines (private Methods) -------------
145
146			#
147			# Process the URL string into its component parts
148			#
149			sub _parseurl {
150			my $self=shift;
151			my $origurl=shift;
152			chomp $origurl;
153
154			my ($type,$rest,$cmdstring)=URLUtilities::parseURL($origurl);
155			my $urlstring="";
156			my $url;
157
158			$base="";
159
160			# check type are supported
161			if ( ! ( exists $self->{'urlmodules'}{$type}) ) {
162			print "URLhandler: Unsupported type $type\n";
163			die;
164			}
165			else {
166			if ( $#{$self->{urlostack}{$type}} < 0 ) {
167			print "URLhandler : base not set for type $type \n";
168			die;
169			}
170			else {
171			# ---- type is supported
172			$urltypehandler=
173			${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}];
174			$base=$urltypehandler->baseurl();
175			}
176			}
177	williamc	1.1
178	williamc	1.7	my $urlbase=($base ne ""?$base."/":"").$rest;
179			$urlstring=$type.":".$urlbase.($cmdstring ne ""?"?".$cmdstring:"");
180			return $urlstring, $type, $urltypehandler, $urlbase, $cmdstring;
181	williamc	1.1	}