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->_urlexpand($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 "" ) {
          $self->{cache}->store($urlstring, $rv);
        }
        return $rv;
}

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

        my $rv="";

        # Process the URL string
        my ($type,$rest,$version)=URLUtilities::parseURL($origurl);
        my ($urltypehandler, $base)=$self->_typecheck($type);

        if ( defined $urltypehandler ) {
             # Call the download module
             $rv=eval{$urltypehandler->get($rest.(($version ne "")?"\?".$version:""), $dirname); };
        }
        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 _typecheck {
        my $self=shift;
        my $type=shift;

        my $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();
           }
        }

        return $urltypehandler, $base;
}

sub _urlexpand {
        my $self=shift;
        my $url=shift;

        my ($type,$rest,$cmds)=URLUtilities::parseURL($url);
        my ($urltypehandler, $base)=$self->_typecheck($type);
        
        my $expurl=$type.":".($base ne ""?$base."/":"").$rest.
                        ($cmds ne ""?"\?".$cmds:"");
        return $expurl;
}
Revision:	1.8
Committed:	Thu Nov 4 13:46:16 1999 UTC (25 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.7:	+20 -26 lines
Log Message:	Use Utilities to expand
#	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	williamc	1.8	=$self->_urlexpand($url); # get a unique url string
62	williamc	1.7	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			$self->{cache}->store($urlstring, $rv);
68			}
69			return $rv;
70	williamc	1.4	}
71
72	williamc	1.7	sub getto ($@) {
73	williamc	1.1	my $self=shift;
74			my $origurl=shift;
75	williamc	1.3	my $dirname=shift;
76	williamc	1.7
77	williamc	1.4	my $rv="";
78	williamc	1.1
79	williamc	1.7	# Process the URL string
80	williamc	1.8	my ($type,$rest,$version)=URLUtilities::parseURL($origurl);
81			my ($urltypehandler, $base)=$self->_typecheck($type);
82	williamc	1.7
83			if ( defined $urltypehandler ) {
84			# Call the download module
85	williamc	1.8	$rv=eval{$urltypehandler->get($rest.(($version ne "")?"\?".$version:""), $dirname); };
86	williamc	1.4	}
87			return $rv;
88	williamc	1.1	}
89
90			sub setbase {
91			my $self=shift;
92			my $type=shift;
93			my @args=@_;
94	williamc	1.2	my $oref;
95	williamc	1.1
96			# Check type is supported
97	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
98	williamc	1.1	print "URLhandler error: Unsupported type $type\n";
99			return 1;
100			}
101			else {
102	williamc	1.2	# A new URL object - pushed onto the stack
103			$oref=eval{$self->{urlmodules}{$type}}->new();
104			push @{$self->{urlostack}{$type}}, $oref;
105			$oref->setbase(@args);
106	williamc	1.1	}
107			}
108
109			sub unsetbase {
110			my $self=shift;
111			my $type=shift;
112	williamc	1.2	my $oref;
113	williamc	1.1
114			# Check type is supported
115	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
116	williamc	1.1	print "URLhandler error: Unsupported type $type\n";
117			return 1;
118			}
119			else {
120	williamc	1.2	# pop off the stack and call the unset base method
121			if ( $#{$self->{urlostack}{$type}} >=0 ) {
122			$oref=pop @{$self->{urlostack}{$type}};
123			$oref->unsetbase();
124			undef $oref;
125	williamc	1.1	}
126	williamc	1.2	else {
127			print "URLhandler error: Unable to unset type $type\n";
128			return 1;
129	williamc	1.1	}
130			}
131			}
132
133	williamc	1.7	# -------------------- Support Routines (private Methods) -------------
134
135			#
136			# Process the URL string into its component parts
137			#
138	williamc	1.8	sub _typecheck {
139	williamc	1.7	my $self=shift;
140	williamc	1.8	my $type=shift;
141	williamc	1.7
142	williamc	1.8	my $base="";
143	williamc	1.7
144			# check type are supported
145			if ( ! ( exists $self->{'urlmodules'}{$type}) ) {
146			print "URLhandler: Unsupported type $type\n";
147			die;
148			}
149			else {
150			if ( $#{$self->{urlostack}{$type}} < 0 ) {
151			print "URLhandler : base not set for type $type \n";
152			die;
153			}
154			else {
155			# ---- type is supported
156			$urltypehandler=
157			${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}];
158			$base=$urltypehandler->baseurl();
159			}
160			}
161	williamc	1.1
162	williamc	1.8	return $urltypehandler, $base;
163			}
164
165			sub _urlexpand {
166			my $self=shift;
167			my $url=shift;
168
169			my ($type,$rest,$cmds)=URLUtilities::parseURL($url);
170			my ($urltypehandler, $base)=$self->_typecheck($type);
171
172			my $expurl=$type.":".($base ne ""?$base."/":"").$rest.
173			($cmds ne ""?"\?".$cmds:"");
174			return $expurl;
175	williamc	1.1	}