ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/URL/URLhandler.pm

Comparing COMP/SCRAM/src/URL/URLhandler.pm (file contents):
Revision 1.1 by williamc, Mon Aug 23 08:56:49 1999 UTC vs.
Revision 1.14 by williamc, Thu May 18 14:57:30 2000 UTC

#	Line 1 | Line 1
1		# url handler -> returns the location of the file
2	–	#
2		# Interface
3		# ---------
4	<	# new() :
5	<	# new(cachedir)       : A new urlhandler with a defined default cahce directory
6	<	# get(url)            : download from the specified url to the default cache
7	<	# get(url,location)        : dowload to the specified directory
8	<	# setcvsco("checkout_cmd") : Default cvs is "co" change with this cmd
9	<	# setbase(type,@args) : set the url defaults for a specific url type
10	<	#                       arguments are dependent on type
12	<	#                       http:
13	<	#                       file:
14	<	#                       cvs: servername,servertype [ ,user,passkey ]
15	<	#                       label:
4	>	# new(cache)       : A new urlhandler with a defined default cahce directory
5	>	# download(url,[location]) : as get but always download
6	>	# get(url,[location]) : download from the specified url to cache or location
7	>	#                       return the full url path name incl. any base expansion
8	>	#                       and the filename downloaded to
9	>	# setbase(type,variablehash) : set the url defaults for a specific url type
10	>	#                              arguments are dependent on type
11		# unsetbase(type)  : deactivate a previously set base
12	<	# usedb($data)     : Set databasecontainer from which to search for tags
12	>	# currentbase(type) : return the current base for the given type
13		#
14		# ----------------------------------------------------------------------
20	–	# returns file location - or crashes out
21	–	# can pass a file name for the item to be stored as
22	–	# if not then stores in a default cache.
15
16	<	package URLhandler;
16	>	package URL::URLhandler;
17		require 5.004;
18		use Utilities::AddDir;
19	+	use URL::URLcache;
20	+	use URL::URLclass;
21	+	use URL::URLbase;
22		use Carp;
23
24		sub new {
#	Line 39 | Line 34 | sub init {
34		use Utilities::AddDir;
35		my $self=shift;
36		my $cache=shift;
42	–	if (! defined $cache  ) { $cache="/tmp/SCRAMcache" }; # default cache
43	–	AddDir::adddir($cache);
37		$self->{cache}=$cache;
38	<	$self->{cvsco}="co";
39	<	@{$self->{urltypes}} = qw(label file cvs http);
40	<	$self->{filebase}="";
38	>	$self->{dummybase}=URL::URLbase->new({});
39	>	$self->{cachestore}=$self->{cache}->filestore();
40	>	use URL::URL_cvs;
41	>	use URL::URL_file;
42	>	use URL::URL_test;
43	>	$self->{urlmodules}={
44	>	'cvs' => 'URL::URL_cvs',
45	>	'file' => 'URL::URL_file',
46	>	'test' => 'URL::URL_test'
47	>	};
48		}
49
50	<	sub get ($@) {
50	>	sub get {
51		my $self=shift;
52		my $origurl=shift;
53	<	my $filename=shift;
54	<	my $rest;
55	<	my $type;
56	<	my $url;
57	<	my $version;
53	>	my $file="";
54	>
55	>	my $url=URL::URLclass->new($origurl);
56	>	my $type=$url->type();
57	>	$url->expandurl($self->currentbase($type));
58	>	my $fullurl=$url->url();
59
60	<	if ( ! defined $filename ) {
61	<	$filename="";
60	>	$file=$self->{cache}->file($fullurl);
61	>	if ( $file eq "" ) {
62	>	($fullurl,$file)=$self->download($origurl, @_);
63		}
64	<	chomp $origurl;
63	<	# get our version info from the url (after last ??)
64	<	( $url, $version) = split /\?\?/, $origurl;
65	<	if ( $url=~/:/ ) {
66	<	($type,$rest) = split /:/, $url;
67	<	}
68	<	else {
69	<	$type='label';
70	<	$rest=$url.":".$version;
71	<	}
72	<	foreach $ty ( @{$self->{urltypes}} ) {
73	<	do { return &$ty($self, $rest, $filename); $supported='yes'; last;}
74	<	, if $type eq $ty;
75	<	}
76	<	if ( ! ( $supported=~/yes/ )) {
77	<	print "URLhandler: Unsupported type $type\n";
78	<	carp;
79	<	}
64	>	return ($fullurl, $file);
65		}
66
67	<	sub usedb {
67	>	sub download {
68		my $self=shift;
69	<	my $db=shift;
85	<
86	<	$self->{db}=$db;
87	<	print "URLhandler warning: db containers not yet Implemented\n";
88	<	}
69	>	my $origurl=shift;
70
71	<	#
72	<	# setcvsco --- to change nature of cvs co (e.g "export" rather than "co")
73	<	#
74	<	sub setcvsco {
75	<	my $self=shift;
95	<	$self->{cvsco}=shift;
96	<	}
71	>	# Process the URL string
72	>	my $url=URL::URLclass->new($origurl);
73	>	my $type=$url->type();
74	>	$urltypehandler=$self->_typehandler($type);
75	>	$url->expandurl($self->currentbase($type));
76
77	<	sub setbase {
78	<	my $self=shift;
79	<	my $type=shift;
80	<	my @args=@_;
81	<
103	<	# Check type is supported
104	<	if ( ! grep( $type, @{$self->{urltypes}}) ) {
105	<	print "URLhandler error: Unsupported type $type\n";
106	<	return 1;
77	>	# Generate a location name if not provided
78	>	$nocache=1;
79	>	if ( @_ ) {
80	>	$location=shift;
81	>	$nocache=0; # dont cache if downloaded to an external location
82		}
83		else {
84	<	&{$type."_setbase"}($self,@args);
84	>	$location=$self->{cache}->filename($url->url());
85		}
86	<	}
87	<
88	<	sub unsetbase {
89	<	my $self=shift;
90	<	my $type=shift;
91	<
92	<	# Check type is supported
93	<	if ( ! grep( $type, @{$self->{urltypes}}) ) {
94	<	print "URLhandler error: Unsupported type $type\n";
120	<	return 1;
121	<	}
122	<	else {
123	<	&{$type."_unsetbase"}($self, @args);
86	>	# -- get the file from the appropriate handler
87	>	if ( defined $urltypehandler ) {
88	>	# Call the download module
89	>	$file=eval{$urltypehandler->get($url, $location)};
90	>	}
91	>
92	>	# now register it in the cache if successful
93	>	if ( $file && $nocache) {
94	>	$self->{cache}->store($url->url(), $location);
95		}
96	+	return ($url->url(), $file);
97		}
98
99	<	# ------------------------- Type Support Routines ----------------------------
128	<	#
129	<	# label:
130	<	#
131	<	sub label {
132	<	my $self=shift;
133	<	my $label=shift;
134	<	my $filename=shift;
135	<	my $returnval="";
136	<
137	<	open ( LOOKUP, "$ENV{SCRAM_LOOKUPDB}" )
138	<	|| die "URLhandler: Unable to open DataBase $ENV{SCRAM_LOOKUPDB} $!";
139	<	while ( <LOOKUP> ) {
140	<	next if /^#/;
141	<	if ( $_=~s/^$label\:// ) {
142	<	$returnval = urlhandler($_,$filename);
143	<	}
144	<	}
145	<	close LOOKUP;
146	<	if ( $returnval ne "" ) {
147	<	return $returnval;
148	<	}
149	<	($proj,$ver)=split /:/, $label;
150	<	print "Error : Unknown project name or version (".$proj." ".$ver.")\n";
151	<	carp;
152	<	}
153	<
154	<	sub label_setbase {
99	>	sub setbase {
100		my $self=shift;
101	<	}
101	>	my $type=shift;
102	>	my @args=@_;
103	>	my $oref;
104
105	<	sub label_unsetbase {
106	<	my $self=shift;
105	>	$self->checktype($type);
106	>	# make a new base object
107	>	my $base=URL::URLbase->new(@_);
108	>	push @{$self->{"basestack"}{$type}}, $base;
109		}
110
111	<	#
163	<	# file:
164	<	#
165	<	sub file {
111	>	sub unsetbase {
112		my $self=shift;
113	<	use File::Copy;
114	<	my $urlfile=shift;
169	<	my $filename=shift;
170	<
171	<	if ( $self->{filebase} ne "" ) { # add a base if it exists
172	<	$urlfile=$self->{filebase}."/".$urlfile;
173	<	}
174	<	if ( -e "$urlfile" ) {
175	<	if ( $filename ne "" ) {
176	<	copy ( $urlfile, $filename ) || return $urlfile;
177	<	return $filename;
178	<	}
179	<	return $urlfile;
180	<	}
181	<	else {
182	<	print "URLhandler: Unable to find file $urlfile : $!\n";
183	<	die "";
184	<	}
185	<	}
113	>	my $type=shift;
114	>	my $oref;
115
116	<	#
117	<	#
118	<	#
119	<	sub file_setbase {
120	<	my $self=shift;
192	<	my $filebase=shift;
193	<
194	<	if ( -d $filebase ) {
195	<	$self->{filebase}=$filebase;
196	<	push  @{$self->{filebasestack}},  $self->{filebase};
116	>	$self->checktype($type);
117	>	# pop off the stack and call the unset base method
118	>	if ( $#{$self->{basestack}{$type}} >=0 ) {
119	>	my $base=pop @{$self->{basestack}{$type}};
120	>	undef $base;
121		}
122		else {
123	<	print "Directory Does Not Exist \n";
124	<	carp;
123	>	die "URLhandler error: Unable to unset type $type\n";
124	>	}
125	>	# remove the stack if its empty
126	>	if ( $#{$self->{basestack}{$type}} == -1 ) {
127	>	delete $self->{basestack}{$type};
128		}
129		}
130
131	<	sub file_unsetbase {
131	>	sub currentbase {
132		my $self=shift;
133	<	pop @{$self->{filebasestack}};
134	<	$self->{filebase}=@{$self->{filebasestack}}
208	<	[$#{$self->{filebasestack}}];
209	<	}
210	<
211	<	#
212	<	# cvs:
213	<	#
214	<
215	<	sub cvs {
216	<	my $self=shift;
217	<	my $url=shift;
218	<	my $dirname=shift;
219	<
220	<	my $cvscmd;
221	<	my $module;
222	<	my $version="";
223	<
224	<	# Where should we co to?
225	<	if ( $dirname eq "" ) {
226	<	$dirname=$self->{cache};
227	<	}
228	<
229	<	# Split up our url into its components
230	<	if ( $url=~/\?/ ) {
231	<	($module, $version)= split /\?/, $url;
232	<	}
233	<	print $url." -----\n";
133	>	my $type=shift;
134	>	my $rv;
135
136	<	if ( $version ne "" ) {
137	<	$cvscmd=$self->{cvsco}." -r $version";
237	<	}
238	<	else {
239	<	$cvscmd=$self->{cvsco};
240	<	}
241	<	#
242	<	# Check to see we have a server and if so attempt the checkout
243	<	#
244	<	if ( ! defined $self->{cvsobject} )  {
245	<	print "urlhandler error: undefined cvs server for $module\n";
246	<	return 1;
136	>	if ( exists $self->{basestack}{$type} ) {
137	>	$rv=${$self->{basestack}{$type}}[$#{$self->{basestack}{$type}}];
138		}
139		else {
140	<	chdir $dirname or carp "Unable to Enter Directory $dirname $!\n";
250	<	$self->{cvsobject}->invokecvs($cvscmd,  $module);
140	>	$rv=$self->{dummybase};
141		}
142	+	return $rv;
143		}
144
145	<	sub cvs_setbase {
145	>	sub checktype($type) {
146		my $self=shift;
147	<	my $base=shift;
257	<	my $auth=shift;
258	<	my $user=shift;
259	<	my $passkey=shift;
260	<	use Utilities::CVSmodule;
261	<
262	<	# Push a new cvs object onto the cvs stack
263	<	$self->{cvsobject}=CVSmodule->new();
264	<	push @{$self->{cvsobjectstack}},$self->{cvsobject};
265	<	$self->{cvsobject}->set_base($base);
266	<	$self->{cvsobject}->set_auth($auth);
267	<	if ( $user ne "" ) {
268	<	$self->{cvsobject}->set_user($user);
269	<	}
270	<	if ( $passkey ne "" ) {
271	<	$self->{cvsobject}->set_passkey($passkey);
272	<	}
273	<	}
274	<
275	<	sub cvs_unsetbase {
276	<	my $self=shift;
277	<	pop @{$self->{cvsobjectstack}};
278	<	$self->{cvsobject}=@{$self->{cvsobjectstack}}
279	<	[$#{$self->{cvsobjectstack}}];
280	<	}
281	<
282	<	#
283	<	# http:
284	<	#
285	<
286	<	sub http {
287	<	my $self=shift;
288	<	my $urlfile=shift;
289	<	my $filename=shift;
290	<	#       use LWP::Simple;
291	<	print "Hello $filename, $urlfile\n";
292	<	#       open (STORE, ">$filename") || carp "unable to open file $filename $!\n";
293	<	#       print STORE (get 'http:'.$urlfile);
294	<	close STORE;
295	<	}
147	>	my $type=shift;
148
149	<	sub http_setbase {
150	<	my $self=shift;
149	>	# Check type is supported
150	>	if ( ! exists $self->{urlmodules}{$type} ) {
151	>	die "URLhandler error: Unsupported type $type\n";
152	>	}
153		}
154
155	<	sub http_unsetbase {
155	>	sub _typehandler {
156		my $self=shift;
157	<	}
157	>	my $type=shift;
158
159	<	# ------------------------ General Support Routines ----------------------------
159	>	$self->checktype($type);
160
161	<	sub cachefilename {
162	<	my $self=shift;
163	<	use File::Basename;
164	<	use Utilities::AddDir;
165	<	my $filebase=dirname($rest);
166	<	$cache="/tmp/williamc/urlhandler$$";
167	<	adddir($cache);
314	<	$filename=$cache."/".$filebase;
161	>	# instantiate only if it dosnt already exist;
162	>	if ( exists $self->{'urlobjs'}{$type} ) {
163	>	$self->{'urlobjs'}{$type};
164	>	}
165	>	else {
166	>	$self->{'urlobjs'}{$type}=$self->{urlmodules}{$type}->new();
167	>	}
168		}
316	–

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines