ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/Utilities/urlhandler.pm

Comparing COMP/SCRAM/src/Utilities/urlhandler.pm (file contents):
Revision 1.4 by williamc, Mon Mar 8 11:51:29 1999 UTC vs.
Revision 1.7 by williamc, Mon Jun 7 15:01:52 1999 UTC

#	Line 1 | Line 1
1		# url handler -> returns the location of the file
2		#
3	+	# Interface
4	+	# ---------
5	+	# new() :
6	+	# new(cachedir)       : A new urlhandler with a defined default cahce directory
7	+	# get(url)            : download from the specified url to the default cache
8	+	# get(url,location)        : dowload to the specified directory
9	+	# setcvsco("checkout_cmd") : Default cvs is "co" change with this cmd
10	+	# setbase(type,@args) : set the url defaults for a specific url type
11	+	#                       arguments are dependent on type
12	+	#                       http:
13	+	#                       file:
14	+	#                       cvs: servername,servertype [ ,user,passkey ]
15	+	#                       label:
16	+	# unsetbase(type)  : deactivate a previously set base
17	+	#
18	+	# ----------------------------------------------------------------------
19		# returns file location - or crashes out
20		# can pass a file name for the item to be stored as
21		# if not then stores in a default cache.
22
23		package urlhandler;
24		require 5.004;
25	<	require Exporter;
10	<	@ISA = qw(Exporter);
11	<	@EXPORT = qw(urlhandler);
25	>	use Utilities::AddDir;
26
27	+	sub new {
28	+	my $class=shift;
29	+	my $cache=shift;
30	+	$self={};
31	+	bless $self, $class;
32	+	$self->init($cache);
33	+	return $self;
34	+	}
35
36	<	sub urlhandler($@) {
36	>	sub init {
37	>	use Utilities::AddDir;
38	>	my $self=shift;
39	>	my $cache=shift;
40	>	if ($cache eq "" ) { $cache="/tmp/SCRAMcache" }; # default cache
41	>	AddDir::adddir($cache);
42	>	$self->{cache}=$cache;
43	>	$self->{cvsco}="co";
44	>	@{$self->{urltypes}} = qw(label file cvs http);
45	>	}
46	>
47	>	sub get ($@) {
48	>	my $self=shift;
49		my $origurl=shift;
50		my $filename=shift;
51		my $rest;
#	Line 29 | Line 63 | sub urlhandler($@) {
63		$type='label';
64		$rest=$url.":".$version;
65		}
66	<
67	<	my @urltypes = qw(label file cvs http);
68	<	foreach $ty ( @urltypes ) {
35	<	do { return &$ty($rest, $filename); $supported='yes'; last; }
36	<	if $type eq $ty;
66	>	foreach $ty ( @{$self->{urltypes}} ) {
67	>	do { return &$ty($self, $rest, $filename); $supported='yes'; last;}
68	>	, if $type eq $ty;
69		}
70		if ( ! ( $supported=~/yes/ )) {
71		print "urlhandler: Unsupported type $type\n";
72		exit 1;
73		}
74		}
75	+
76	+	#
77	+	# setcvsco --- to change nature of cvs co (e.g "export" rather than "co")
78	+	#
79	+	sub setcvsco {
80	+	my $self=shift;
81	+	$self->{cvsco}=shift;
82	+	}
83	+
84	+	sub setbase {
85	+	my $self=shift;
86	+	my $type=shift;
87	+	my @args=@_;
88	+
89	+	# Check type is supported
90	+	if ( ! grep( $type, @{$self->{urltypes}}) ) {
91	+	print "urlhandler error: Unsupported type $type\n";
92	+	return 1;
93	+	}
94	+	else {
95	+	&{$type."_setbase"}($self,@args);
96	+	}
97	+	}
98	+
99	+	sub unsetbase {
100	+	my $self=shift;
101	+	my $type=shift;
102	+
103	+	# Check type is supported
104	+	if ( ! grep( $type, @{$self->{urltypes}}) ) {
105	+	print "urlhandler error: Unsupported type $type\n";
106	+	return 1;
107	+	}
108	+	else {
109	+	&{$type."_unsetbase"}($self, @args);
110	+	}
111	+	}
112	+
113	+	# ------------------------- Type Support Routines ----------------------------
114	+	#
115	+	# label:
116	+	#
117		sub label {
118	+	my $self=shift;
119		my $label=shift;
120		my $filename=shift;
121		my $returnval="";
#	Line 54 | Line 129 | sub label {
129		}
130		}
131		close LOOKUP;
132	<	return $returnval;
133	<
132	>	if ( $returnval ne "" ) {
133	>	return $returnval;
134	>	}
135	>	($proj,$ver)=split /:/, $label;
136	>	print "Error : Unknown project name or version (".$proj." ".$ver.")\n";
137	>	exit 1;
138	>	}
139	>
140	>	sub label_setbase {
141	>	my $self=shift;
142		}
143
144	+	sub label_unsetbase {
145	+	my $self=shift;
146	+	}
147	+
148	+	#
149	+	# file:
150	+	#
151		sub file {
152	+	my $self=shift;
153		use File::Copy;
154		my $urlfile=shift;
155		my $filename=shift;
156	+
157	+	if ( $self->{filebase} ne "" ) { # add a base if it exists
158	+	$urlfile=$self->{filebase}."/".$urlfile;
159	+	}
160		if ( -e "$urlfile" ) {
161	<	if ( $filename=~/.*/ ) {
161	>	if ( $filename ne "" ) {
162		copy ( $urlfile, $filename ) || return $urlfile;
163		return $filename;
164		}
#	Line 75 | Line 170 | sub file {
170		}
171		}
172
173	+	#
174	+	#
175	+	#
176	+	sub file_setbase {
177	+	my $self=shift;
178	+	my $filebase=shift;
179	+
180	+	if ( -d $filebase ) {
181	+	$self->{filebase}=$filebase;
182	+	push  @{$self->{filebasestack}},  $self->{filebase};
183	+	}
184	+	else {
185	+	die "Directory Does Not Exist \n";
186	+	}
187	+	}
188	+
189	+	sub file_unsetbase {
190	+	my $self=shift;
191	+	pop @{$self->{filebasestack}};
192	+	$self->{filebase}=@{$self->{filebasestack}}
193	+	[$#{$self->{filebasestack}}];
194	+	}
195	+
196	+	#
197	+	# cvs:
198	+	#
199	+
200		sub cvs {
201	<	print "Coming soon\n";
201	>	my $self=shift;
202	>	my $url=shift;
203	>	my $dirname=shift;
204	>
205	>	my $cvscmd;
206	>	my $module;
207	>	my $version;
208	>
209	>	# Where should we co to?
210	>	if ( $dirname eq "" ) {
211	>	$dirname=$self->{cache};
212	>	}
213	>
214	>	# Split up our url into its components
215	>	($module, $version)= split /\?/, $url;
216	>
217	>	if ( $version ne "" ) {
218	>	$cvscmd=$self->{cvsco}." -r $version";
219	>	}
220	>	else {
221	>	$cvscmd=$self->{cvsco}
222	>	}
223	>	#
224	>	# Check to see we have a server and if so attempt the checkout
225	>	#
226	>	if ( ! defined $self->{cvsobject} )  {
227	>	print "urlhandler error: undefined cvs server for $module\n";
228	>	return 1;
229	>	}
230	>	else {
231	>	chdir $dirname or die "Unable to Enter Directory $dirname $!\n";
232	>	$self->{cvsobject}->invokecvs($cvscmd,  $module);
233	>	}
234	>	}
235	>
236	>	sub cvs_setbase {
237	>	my $self=shift;
238	>	my $base=shift;
239	>	my $auth=shift;
240	>	my $user=shift;
241	>	my $passkey=shift;
242	>
243	>	# Push a new cvs object onto the cvs stack
244	>	$self->{cvsobject}=cvsmodule->new();
245	>	push @{$self->{cvsobjectstack}},$self->{cvsobject};
246	>	$self->{cvsobject}->set_base($base);
247	>	$self->{cvsobject}->set_auth($auth);
248	>	if ( $user ne "" ) {
249	>	$self->{cvsobject}->set_user($user);
250	>	}
251	>	if ( $passkey ne "" ) {
252	>	$self->{cvsobject}->set_passkey($passkey);
253	>	}
254	>	}
255	>
256	>	sub cvs_unsetbase {
257	>	my $self=shift;
258	>	pop @{$self->{cvsobjectstack}};
259	>	$self->{cvsobject}=@{$self->{cvsobjectstack}}
260	>	[$#{$self->{cvsobjectstack}}];
261		}
262
263	+	#
264	+	# http:
265	+	#
266	+
267		sub http {
268	+	my $self=shift;
269		my $urlfile=shift;
270		my $filename=shift;
271	<	use LWP::Simple;
272	<	open (STORE, $filename);
273	<	getprint STORE 'http:'.$urlfile;
271	>	#       use LWP::Simple;
272	>	print "Hello $filename, $urlfile\n";
273	>	#       open (STORE, ">$filename") || die "unable to open file $filename $!\n";
274	>	#       print STORE (get 'http:'.$urlfile);
275		close STORE;
276		}
277
278	+	sub http_setbase {
279	+	my $self=shift;
280	+	}
281	+
282	+	sub http_unsetbase {
283	+	my $self=shift;
284	+	}
285	+
286	+	# ------------------------ General Support Routines ----------------------------
287	+
288		sub cachefilename {
289	+	my $self=shift;
290		use File::Basename;
291		use Utilities::AddDir;
292		my $filebase=dirname($rest);

Diff Legend

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