ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/BuildSystem/Requirements.pm

Comparing COMP/SCRAM/src/BuildSystem/Requirements.pm (file contents):
Revision 1.7 by sashby, Fri Nov 16 16:29:48 2001 UTC vs.
Revision 1.22 by sashby, Wed Feb 15 17:14:17 2006 UTC

#	Line 21 | Line 21 | use Utilities::Verbose;
21		require 5.004;
22		@ISA=qw(Utilities::Verbose);
23
24	<	sub new {
25	<	my $class=shift;
26	<	my $self={};
27	<	bless $self, $class;
28	<	$self->{dbstore}=shift;
29	<	$self->{file}=shift;
30	<	$self->{cache}=$self->{dbstore}->cache();
31	<	if ( @_ ) {
32	<	$self->arch(shift);
33	<	}
34	<	$self->verbose("Initialising a new Requirements Doc");
35	<	$self->{mydocversion}="2.0";
36	<	$self->{Arch}=1;
37	<	push @{$self->{ARCHBLOCK}}, $self->{Arch};
38	<	$self->init($self->{file});
39	<	return $self;
40	<	}
41	<
42	<	sub url {
43	<	my $self=shift;
44	<	if ( @_ ) {
45	<	$self->{file}=shift;
46	<	}
47	<	return $self->{file}
48	<	}
24	>	sub new
25	>	{
26	>	my $class=shift;
27	>	my $self={};
28	>	bless $self, $class;
29	>	$self->{dbstore}=shift;
30	>	$self->{file}=shift;
31	>	$self->{cache}=$self->{dbstore}->cache();
32	>
33	>	if ( @_ )
34	>	{
35	>	$self->arch(shift);
36	>	}
37	>	$self->verbose("Initialising a new Requirements Doc");
38	>	$self->{mydocversion}="2.0";
39	>	# Counter for downloaded tools: zero it here. It will
40	>	# be auto-incremented as each tool is selected:
41	>	$self->{selectcounter}=0;
42	>
43	>	$self->{Arch}=1;
44	>	push @{$self->{ARCHBLOCK}}, $self->{Arch};
45	>	$self->init($self->{file});
46	>	return $self;
47	>	}
48	>
49	>	sub toolmanager
50	>	{
51	>	my $self=shift;
52	>
53	>	@_ ? $self->{toolmanagerobject} = shift
54	>	: $self->{toolmanagerobject};
55	>
56	>	}
57	>
58	>	sub configversion
59	>	{
60	>	my $self=shift;
61	>	@_ ? $self->{configversion} = shift
62	>	: $self->{configversion};
63	>	}
64	>
65	>	sub url
66	>	{
67	>	my $self=shift;
68	>
69	>	if ( @_ )
70	>	{
71	>	$self->{file}=shift;
72	>	}
73	>	return $self->{file};
74	>	}
75	>
76	>	sub tools
77	>	{
78	>	my $self=shift;
79	>	return @{$self->{tools}};
80	>	}
81	>
82	>	sub toolcomment
83	>	{
84	>	my $self=shift;
85	>	my $tool=shift;
86	>	my $version=shift;
87	>
88	>	return $self->{reqtext}{$tool}{$version};
89	>	}
90	>
91	>	sub distributionurl
92	>	{
93	>	my $self=shift;
94	>	my $tool=shift;
95	>	my $version=shift;
96	>
97	>	return ( defined $self->{dist}{$tool}{$version})?
98	>	$self->{dist}{$tool}{$version}:undef;
99	>	}
100	>
101	>	sub version
102	>	{
103	>	my $self=shift;
104	>	my $tool=shift;
105	>	return $self->{'version'}{$tool};
106	>	}
107	>
108	>	sub toolurl
109	>	{
110	>	my $self=shift;
111	>	my $tool=shift;
112	>	return $self->{'url'}{$tool};
113	>	}
114	>
115	>	sub init
116	>	{
117	>	my $self=shift;
118	>	my $url=shift;
119	>
120	>	my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
121	>	$switch->verbosity($self->verbosity());
122	>	$switch->url($url);
123	>	$switch->newparse("ordering");
124	>	$switch->addbasetags("ordering");
125	>
126	>	$switch->addtag("ordering","Architecture",
127	>	\&Arch_Start,$self,
128	>	"", $self,
129	>	\&Arch_End, $self);
130	>	$switch->addtag("ordering","select",
131	>	\&select_start,$self,
132	>	"", $self,
133	>	"", $self);
134	>	$switch->grouptag("Architecture","ordering");
135	>	$switch->addtag("ordering","require",
136	>	\&require_start,$self,
137	>	\&require_text, $self,
138	>	\&require_end, $self);
139	>
140	>	$self->{reqcontext}=0;
141	>	$self->{switch}=$switch;
142	>	undef $self->{restrictstack};
143	>	@{$self->{tools}}=();
144	>
145	>	my($doctype,$docversion)=$switch->doctype();
146	>	# -- for backwards compatability only parse if we have a docversion
147	>	#    defined:
148	>	if ( defined $docversion )
149	>	{
150	>	if ($docversion eq $self->{mydocversion})
151	>	{
152	>	@{$self->{ArchStack}}=();
153	>	$self->verbose("Initial Document Parse");
154	>	$self->{switch}->parse("ordering");
155	>	# Set the config version. If there isn't a version, it means that we
156	>	# have a stand-alone repository for the toolbox, rather than a CVS
157	>	# one. Hence, no CVS tag (== version):
158	>	($switch->{configurl}->param('version') eq '') ?
159	>	$self->configversion("STANDALONE") :
160	>	$self->configversion($switch->{configurl}->param('version'));
161	>	}
162	>	else
163	>	{
164	>	$self->verbose("wrong doc version - not parsing");
165	>	}
166	>	}
167	>	else
168	>	{
169	>	$self->verbose("wrong doc type - not parsing");
170	>	}
171	>	}
172	>
173	>	sub arch
174	>	{
175	>	my $self=shift;
176	>	# $self->arch is the SCRAM_ARCH value:
177	>	if ( @_ )
178	>	{
179	>	$self->{arch}=shift;
180	>	}
181	>	else
182	>	{
183	>	if ( ! defined $self->{arch} )
184	>	{
185	>	$self->{arch}="";
186	>	}
187	>	}
188	>	return $self->{arch};
189	>	}
190	>
191	>	sub archlist
192	>	{
193	>	my $self=shift;
194	>	return @{$self->{ArchStack}};
195	>	}
196	>
197	>	sub getreqforarch
198	>	{
199	>	my $self=shift;
200	>	my $arch=shift;
201	>
202	>	if ( ! defined $self->{reqsforarch}{$arch} )
203	>	{
204	>	$self->{reqsforarch}{$arch}=
205	>	BuildSystem::Requirements->new($self->{dbstore},$self->{file},
206	>	$arch);
207	>	}
208	>	return $self->{reqsforarch}{$arch};
209	>	}
210
211	<	sub setup
211	>	sub download
212		{
213		my $self=shift;
53	–	my $toolbox=shift;
214		my $tool;
215	+	$| = 1; # Unbuffer the output
216	+
217	+	print  "Downloading tool descriptions....","\n";
218	+	print  " ";
219	+	foreach $tool ( $self->tools() )
220	+	{
221	+	print "#";
222	+	$self->verbose("Downloading ".$self->toolurl($tool));
223	+	# get into the cache:
224	+	$self->{switch}->urlget($self->toolurl($tool));
225	+	}
226	+	print "\nDone.","\n";
227	+	# So now add the list of downloaded tools, and which were
228	+	# selected, to tool cache:
229	+	print "Tool info cached locally.","\n","\n";
230	+
231	+	# Now copy required info from this object to ToolManager (ToolCache):
232	+	$self->toolmanager()->downloadedtools($self->{tools});
233	+	$self->toolmanager()->defaultversions($self->{version});
234	+	$self->toolmanager()->toolurls($self->{url});
235	+	$self->toolmanager()->selected($self->{selected});
236	+	}
237	+
238	+	sub _autoselect
239	+	{
240	+	my $self=shift;
241	+	if ( @_ )
242	+	{
243	+	$self->{autoselect}=shift;
244	+	}
245	+	# -- default is true
246	+	return ((defined $self->{autoselect})?$self->{autoselect}:1);
247	+	}
248
249	<	foreach $tool ( $self->selectedtools() )
249	>	sub require_start
250	>	{
251	>	my $self=shift;
252	>	my $name=shift;
253	>	my $hashref=shift;
254	>
255	>	$self->{switch}->checktag( $name, $hashref, 'version');
256	>	$self->{switch}->checktag( $name, $hashref, 'name');
257	>	$self->{switch}->checktag( $name, $hashref, 'url');
258	>
259	>	if ( $self->{reqcontext} == 1 )
260		{
261	<	$self->verbose("Setting Up Tool $tool");
262	<	$toolbox->toolsetup($tool, $self->version($tool), $self->toolurl($tool));
261	>	$self->{switch}->parseerror(
262	>	"Open new $name context without previous </$name>");
263	>	}
264	>	$self->{reqcontext}=1;
265	>	$$hashref{'name'}=~tr[A-Z][a-z];
266	>
267	>	# Add protection so that architecture tags are obeyed during download:
268	>	if ( $self->{Arch} )
269	>	{
270	>	# Add tool to the tool array:
271	>	push @{$self->{tools}}, $$hashref{'name'};
272	>
273	>	# If the tool already has an entry, modify the version string to
274	>	# include both versions. The versions can later be separated and
275	>	# parsed as normal:
276	>	if (defined $self->{version}{$$hashref{'name'}})
277	>	{
278	>	# Don't need an extra entry for this tool onto tool array:
279	>	pop @{$self->{tools}}, $$hashref{'name'};
280	>	# Modify the version string to append the other tool version.
281	>	# Separate using a colon:
282	>	my $newversion=$self->{version}{$$hashref{'name'}}.":".$$hashref{'version'};
283	>	$self->{version}{$$hashref{'name'}}=$newversion;
284	>	}
285	>	else
286	>	{
287	>	$self->{version}{$$hashref{'name'}}=$$hashref{'version'};
288	>	}
289	>	# -- make sure the full url is taken
290	>	my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
291	>
292	>	$self->{url}{$$hashref{'name'}}=$urlobj->url();
293	>
294	>	$self->{creqtool}=$$hashref{'name'};
295	>	$self->{creqversion}=$$hashref{'version'};
296	>	$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
297		}
298		}
299
300	<	sub tools {
301	<	my $self=shift;
302	<	return @{$self->{tools}};
303	<	}
304	<
305	<	sub selectedtools {
306	<	my $self=shift;
307	<	my @toollist=();
308	<	foreach $tool (  @{$self->{tools}} ) {
309	<	if ( $self->{selected}{$tool} == 1 ) {
310	<	push @toollist, $tool;
311	<	}
312	<	}
313	<	return @toollist;
314	<	}
315	<
316	<	sub toolcomment {
317	<	my $self=shift;
318	<	my $tool=shift;
319	<	my $version=shift;
320	<
321	<	return $self->{reqtext}{$tool}{$version};
322	<	}
323	<
324	<	sub distributionurl {
325	<	my $self=shift;
326	<	my $tool=shift;
327	<	my $version=shift;
328	<
329	<	return ( defined $self->{dist}{$tool}{$version})?
330	<	$self->{dist}{$tool}{$version}:undef;
331	<	}
332	<
333	<	sub version {
334	<	my $self=shift;
335	<	my $tool=shift;
336	<	return $self->{'version'}{$tool};
337	<	}
338	<
339	<	sub toolurl {
340	<	my $self=shift;
341	<	my $tool=shift;
342	<	return $self->{'url'}{$tool};
343	<	}
344	<
345	<	sub init {
346	<	my $self=shift;
347	<	my $url=shift;
348	<
349	<	my $switch=ActiveDoc::ActiveDoc->new($self->{dbstore});
350	<	$switch->verbosity($self->verbosity());
351	<	$switch->url($url);
352	<	$switch->newparse("ordering");
353	<	$switch->addbasetags("ordering");
354	<	$switch->addtag("ordering","Architecture",
355	<	\&Arch_Start,$self,
356	<	"", $self,
357	<	\&Arch_End, $self);
358	<	$switch->addtag("ordering","Restrict",
359	<	\&Restrict_start,$self,
360	<	"", $self,
361	<	\&Restrict_end, $self);
362	<	$switch->addtag("ordering","deselect",
363	<	\&deselect_start,$self,
364	<	"", $self,
365	<	"", $self);
366	<	$switch->addtag("ordering","select",
367	<	\&select_start,$self,
368	<	"", $self,
369	<	"", $self);
370	<	$switch->addtag("ordering","distribution",
371	<	\&disttag,$self);
372	<	$switch->grouptag("Architecture","ordering");
373	<	$switch->addtag("ordering","require",
374	<	\&require_start,$self,
375	<	\&require_text, $self,
376	<	\&require_end, $self);
377	<
378	<	$self->{reqcontext}=0;
379	<	$self->{switch}=$switch;
143	<	undef $self->{restrictstack};
144	<	@{$self->{tools}}=();
145	<
146	<	my($doctype,$docversion)=$switch->doctype();
147	<	# -- for backwards compatability only parse if we have a docversion
148	<	#    defined
149	<	if ( defined $docversion ) {
150	<	if ( $docversion eq $self->{mydocversion} ) {
151	<	@{$self->{ArchStack}}=();
152	<	$self->verbose("Initial Document Parse");
153	<	$self->{switch}->parse("ordering");
154	<	}
155	<	else {
156	<	$self->verbose("wrong doc version - not parsing");
157	<	}
158	<	}
159	<	else {
160	<	$self->verbose("wrong doc type - not parsing");
161	<	}
162	<	}
163	<
164	<	sub arch {
165	<	my $self=shift;
166	<	if ( @_ ) {
167	<	$self->{arch}=shift
168	<	}
169	<	else {
170	<	if ( ! defined $self->{arch} ) {
171	<	$self->{arch}="";
172	<	}
173	<	}
174	<	return $self->{arch};
175	<	}
176	<
177	<	sub archlist {
178	<	my $self=shift;
179	<	return @{$self->{ArchStack}};
180	<	}
181	<
182	<	sub getreqforarch {
183	<	my $self=shift;
184	<	my $arch=shift;
185	<
186	<	if ( ! defined $self->{reqsforarch}{$arch} ) {
187	<	$self->{reqsforarch}{$arch}=
188	<	BuildSystem::Requirements->new($self->{dbstore},$self->{file},
189	<	$arch);
190	<	}
191	<	return $self->{reqsforarch}{$arch};
192	<	}
193	<
194	<
195	<	sub download {
196	<	my $self=shift;
197	<
198	<	my $tool;
199	<	foreach $tool ( $self->tools() ) {
200	<	$self->verbose("Downloading ".$self->toolurl($tool));
201	<	# get into the cache
202	<	$self->{switch}->urlget($self->toolurl($tool));
203	<	}
204	<	}
205	<
206	<	sub _autoselect {
207	<	my $self=shift;
208	<	if ( @_ ) {
209	<	$self->{autoselect}=shift;
210	<	}
211	<	# -- default is true
212	<	return ((defined $self->{autoselect})?$self->{autoselect}:1);
213	<	}
214	<
215	<	# ---- Tag routines
216	<
217	<	sub Restrict_start {
218	<	my $self=shift;
219	<	my $name=shift;
220	<	my $hashref=shift;
221	<
222	<	$self->{switch}->checktag( $name, $hashref, 'autoselect');
223	<	if ( $self->{Arch} ) {
224	<	# -- create selection state stack
225	<	push @{$self->{restrictstack}}, $self->_autoselect();
226	<	$self->_autoselect(
227	<	(($$hashref{'autoselect'}=~/true/i)?1:0));
228	<	}
229	<	}
230	<
231	<	sub Restrict_end {
232	<	my $self=shift;
233	<	my $name=shift;
234	<
235	<	if ( $self->{Arch} ) {
236	<	if ( $#{$self->{restrictstack}} >= 0 ) {
237	<	$self->_autoselect(pop @{$self->{restrictstack}});
238	<	}
239	<	else {
240	<	$self->{switch}->parseerror("Unmatched </$name>");
241	<	}
242	<	}
243	<	}
244	<
245	<	sub require_start {
246	<	my $self=shift;
247	<	my $name=shift;
248	<	my $hashref=shift;
249	<
250	<	$self->{switch}->checktag( $name, $hashref, 'version');
251	<	$self->{switch}->checktag( $name, $hashref, 'name');
252	<	$self->{switch}->checktag( $name, $hashref, 'url');
253	<
254	<	if ( $self->{reqcontext} == 1 ) {
255	<	$self->{switch}->parseerror(
256	<	"Open new $name conext without previous </$name>");
257	<	}
258	<	$self->{reqcontext}=1;
259	<	$$hashref{'name'}=~tr[A-Z][a-z];
260	<	push @{$self->{tools}}, $$hashref{'name'};
261	<	$self->{version}{$$hashref{'name'}}=$$hashref{'version'};
262	<	# -- make sure the full url is taken
263	<	my $urlobj=$self->{switch}->expandurl($$hashref{'url'});
264	<	$self->{url}{$$hashref{'name'}}=$urlobj->url();
265	<
266	<	# -- selection
267	<	if ( $self->{Arch} ) {
268	<	if ( $self->_autoselect() ) {
269	<	$self->{selected}{$$hashref{'name'}}=1;
270	<	}
271	<	else {
272	<	$self->{selected}{$$hashref{'name'}}=0;
273	<	}
274	<	}
275	<	$self->{creqtool}=$$hashref{'name'};
276	<	$self->{creqversion}=$$hashref{'version'};
277	<	$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}="";
278	<	}
279	<
280	<	sub require_text {
281	<	my $self=shift;
282	<	my $name=shift;
283	<	my $string=shift;
284	<
285	<	chomp $string;
286	<	$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
287	<	$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
288	<	$string;
289	<
290	<	}
291	<
292	<	sub require_end {
293	<	my $self=shift;
294	<	my $name=shift;
295	<
296	<	if ( $self->{reqcontext} != 1 ) {
297	<	$self->{switch}->parseerror("No matching tag for </$name>");
298	<	}
299	<	else {
300	<	$self->{reqcontext}=0;
301	<	}
302	<	}
303	<
304	<	sub select_start {
305	<	my $self=shift;
306	<	my $name=shift;
307	<	my $hashref=shift;
308	<
309	<	$self->{switch}->checktag( $name, $hashref, 'name');
310	<	$$hashref{'name'}=~tr[A-Z][a-z];
311	<	if ( $self->{Arch} ) {
312	<	$self->verbose("Selecting ".$$hashref{'name'});
313	<	$self->{selected}{$$hashref{'name'}}=1;
314	<	}
315	<	}
316	<
317	<	sub deselect_start {
318	<	my $self=shift;
319	<	my $name=shift;
320	<	my $hashref=shift;
321	<
322	<	$self->{switch}->checktag( $name, $hashref, 'name');
323	<	$$hashref{'name'}=~tr[A-Z][a-z];
324	<	if ( $self->{Arch} ) {
325	<	$self->verbose("Deselecting ".$$hashref{'name'});
326	<	$self->{selected}{$$hashref{'name'}}=0;
327	<	}
328	<	}
329	<
330	<	sub Arch_Start {
331	<	my $self=shift;
332	<	my $name=shift;
333	<	my $hashref=shift;
334	<
335	<	$self->{switch}->checktag($name, $hashref,'name');
336	<
337	<	( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
338	<	: ($self->{Arch}=0);
339	<	$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
340	<	push @{$self->{ARCHBLOCK}}, $self->{Arch};
341	<	push @{$self->{ArchStack}}, $$hashref{'name'};
342	<	}
343	<
344	<	sub Arch_End {
345	<	my $self=shift;
346	<	my $name=shift;
347	<
348	<	pop @{$self->{ARCHBLOCK}};
349	<	$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
350	<	}
351	<
352	<	sub disttag {
353	<	my $self=shift;
354	<	my $name=shift;
355	<	my $hashref=shift;
356	<
357	<	if ( exists $$hashref{'url'} ) {
358	<	$self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
359	<	$$hashref{'url'};
360	<	}
361	<	}
300	>	sub require_text
301	>	{
302	>	my $self=shift;
303	>	my $name=shift;
304	>	my $string=shift;
305	>
306	>	chomp $string;
307	>	$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}=
308	>	$self->{reqtext}{$self->{creqtool}}{$self->{creqversion}}.
309	>	$string;
310	>	}
311	>
312	>	sub require_end
313	>	{
314	>	my $self=shift;
315	>	my $name=shift;
316	>
317	>	if ( $self->{reqcontext} != 1 )
318	>	{
319	>	$self->{switch}->parseerror("No matching tag for </$name>");
320	>	}
321	>	else
322	>	{
323	>	$self->{reqcontext}=0;
324	>	}
325	>	}
326	>
327	>	sub select_start
328	>	{
329	>	my $self=shift;
330	>	my $name=shift;
331	>	my $hashref=shift;
332	>
333	>	$self->{switch}->checktag( $name, $hashref, 'name');
334	>	$$hashref{'name'}=~tr[A-Z][a-z];
335	>	if ( $self->{Arch} )
336	>	{
337	>	$self->verbose("Selecting ".$$hashref{'name'});
338	>	# Increment counter:
339	>	$self->{selectcounter}++;
340	>	$self->{selected}{$$hashref{'name'}}=$self->{selectcounter};
341	>	}
342	>	}
343	>
344	>	sub Arch_Start
345	>	{
346	>	my $self=shift;
347	>	my $name=shift;
348	>	my $hashref=shift;
349	>
350	>	# Check the architecture tag:
351	>	$self->{switch}->checktag($name, $hashref,'name');
352	>	( ($self->arch()=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
353	>	: ($self->{Arch}=0);
354	>
355	>	$self->verbose(($self->{Arch}?"OK":"skipping")." ".$$hashref{name});
356	>	push @{$self->{ARCHBLOCK}}, $self->{Arch};
357	>	push @{$self->{ArchStack}}, $$hashref{'name'};
358	>	}
359	>
360	>	sub Arch_End
361	>	{
362	>	my $self=shift;
363	>	my $name=shift;
364	>	pop @{$self->{ARCHBLOCK}};
365	>	$self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
366	>	}
367	>
368	>	sub disttag
369	>	{
370	>	my $self=shift;
371	>	my $name=shift;
372	>	my $hashref=shift;
373	>
374	>	if ( exists $$hashref{'url'} )
375	>	{
376	>	$self->{dist}{$self->{creqtool}}{$self->{creqversion}}=
377	>	$$hashref{'url'};
378	>	}
379	>	}

Diff Legend

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