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.6 by williamc, Fri Jun 4 16:57:04 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;
26	<	@ISA = qw(Exporter);
27	<	@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 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 urlhandler($@) {
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;
#	Line 75 | Line 166 | sub file {
166		}
167		}
168
169	+	sub file_setbase {
170	+	my $self=shift;
171	+	}
172	+
173	+	sub file_unsetbase {
174	+	my $self=shift;
175	+	}
176	+
177	+	#
178	+	# cvs:
179	+	#
180	+
181		sub cvs {
182	<	print "Coming soon\n";
182	>	my $self=shift;
183	>	my $url=shift;
184	>	my $dirname=shift;
185	>
186	>	my $cvscmd;
187	>	my $module;
188	>	my $version;
189	>
190	>	# Where should we co to?
191	>	if ( $dirname eq "" ) {
192	>	$dirname=$self->{cache};
193	>	}
194	>
195	>	# Split up our url into its components
196	>	($module, $version)= split /\?/, $url;
197	>
198	>	if ( $version ne "" ) {
199	>	$cvscmd=$self->{cvsco}." -r $version";
200	>	}
201	>	else {
202	>	$cvscmd=$self->{cvsco}
203	>	}
204	>	#
205	>	# Check to see we have a server and if so attempt the checkout
206	>	#
207	>	if ( ! defined $self->{cvsobject} )  {
208	>	print "urlhandler error: undefined cvs server for $module\n";
209	>	return 1;
210	>	}
211	>	else {
212	>	chdir $dirname or die "Unable to Enter Directory $dirname $!\n";
213	>	$self->{cvsobject}->invokecvs($cvscmd,  $module);
214	>	}
215		}
216
217	+	sub cvs_setbase {
218	+	my $self=shift;
219	+	my $base=shift;
220	+	my $auth=shift;
221	+	my $user=shift;
222	+	my $passkey=shift;
223	+
224	+	# Push a new cvs object onto the cvs stack
225	+	$self->{cvsobject}=cvsmodule->new();
226	+	push @{$self->{cvsobjectstack}},$self->{cvsobject};
227	+	$self->{cvsobject}->set_base($base);
228	+	$self->{cvsobject}->set_auth($auth);
229	+	if ( $user ne "" ) {
230	+	$self->{cvsobject}->set_user($user);
231	+	}
232	+	if ( $passkey ne "" ) {
233	+	$self->{cvsobject}->set_passkey($passkey);
234	+	}
235	+	}
236	+
237	+	sub cvs_unsetbase {
238	+	my $self=shift;
239	+	pop @{$self->{cvsobjectstack}};
240	+	$self->{cvsobject}=@{$self->{cvsobjectstack}}
241	+	[$#{$self->{cvsobjectstack}}];
242	+	}
243	+
244	+	#
245	+	# http:
246	+	#
247	+
248		sub http {
249	+	my $self=shift;
250		my $urlfile=shift;
251		my $filename=shift;
252	<	use LWP::Simple;
253	<	open (STORE, $filename);
254	<	getprint STORE 'http:'.$urlfile;
252	>	#       use LWP::Simple;
253	>	print "Hello $filename, $urlfile\n";
254	>	#       open (STORE, ">$filename") || die "unable to open file $filename $!\n";
255	>	#       print STORE (get 'http:'.$urlfile);
256		close STORE;
257		}
258
259	+	sub http_setbase {
260	+	my $self=shift;
261	+	}
262	+
263	+	sub http_unsetbase {
264	+	my $self=shift;
265	+	}
266	+
267	+	# ------------------------ General Support Routines ----------------------------
268	+
269		sub cachefilename {
270	+	my $self=shift;
271		use File::Basename;
272		use Utilities::AddDir;
273		my $filebase=dirname($rest);

Diff Legend

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