ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

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

Comparing COMP/SCRAM/src/BuildSystem/ToolParser.pm (file contents):
Revision 1.4 by sashby, Wed Apr 13 16:45:36 2005 UTC vs.
Revision 1.6 by sashby, Tue Feb 27 11:59:45 2007 UTC

#	Line 15 | Line 15 | require 5.004;
15		use Exporter;
16		use ActiveDoc::SimpleDoc;
17		use Utilities::Verbose;
18	–	use BuildSystem::ToolTagUtils;
18
19		@ISA=qw(Exporter Utilities::Verbose);
20		@EXPORT=qw();
#	Line 34 | Line 33 | sub new
33		{
34		my $proto=shift;
35		my $class=ref($proto) || $proto;
36	<	my $self={};
36	>	$self={};
37
38		bless $self,$class;
39
#	Line 44 | Line 43 | sub new
43		$self->{interactive} = 0;
44		$self->{content} = {};
45		$self->{nested} = 0;
46	+	$self->{scramdoc}=ActiveDoc::SimpleDoc->new();
47	+	$self->{scramdoc}->newparse("setup", $self->{mydoctype},'Subs');
48	+
49	+	return $self;
50	+	}
51	+
52	+	### Tag handler methods ###
53	+	sub tool()
54	+	{
55	+	my ($object,$name,%attributes)=@_;
56	+	my $hashref = \%attributes;
57	+	# A way to distinguish the naming of different nested levels:
58	+	$self->{levels}=['','tag','nexttag'];
59	+	$$hashref{'name'} =~ tr[A-Z][a-z];
60	+
61	+	# Make sure we only pick up the tool requested:
62	+	if ( ($self->{tool} eq $$hashref{'name'}) &&
63	+	($self->{version} eq $$hashref{'version'} ))
64	+	{
65	+	# These variables will be used when expanding settings
66	+	# in tool variable defs:
67	+	$ENV{SCRAMToolname} = $$hashref{'name'};
68	+	$ENV{SCRAMToolversion} = $$hashref{'version'};
69	+	$self->{content}->{TOOLNAME}=$$hashref{'name'};
70	+	$self->{content}->{TOOLVERSION}=$$hashref{'version'};
71	+	}
72	+	else
73	+	{
74	+	print "\n";
75	+	$::scram->scramerror("Configuration problem! Wanted/actual ".$self->{tool}." tool versions differ (wanted = ".$self->{version}.", downloaded = ".$$hashref{'version'}.")\n");
76	+	}
77
78	<	$self->_initparser();
78	>	# Test to see if this doc defines a
79	>	# scram-managed project or a compiler:
80	>	if (exists ($$hashref{'type'}))
81	>	{
82	>	$$hashref{'type'} =~ tr[A-Z][a-z];
83	>	$self->{content}->{SCRAM_PROJECT} = 0;
84	>
85	>	if ($$hashref{'type'} eq 'scram')
86	>	{
87	>	$self->{content}->{SCRAM_PROJECT} = 1;
88	>	}
89	>	elsif ($$hashref{'type'} eq 'compiler')
90	>	{
91	>	# Is tool a compiler? Store this for retrieval from tool manager obj:
92	>	$self->{content}->{SCRAM_COMPILER} = 1;
93	>	}
94	>	else
95	>	{
96	>	$::scram->scramwarn("Unknown type \"".$$hashref{'type'}."\" in tool ".$$hashref{'name'}."\n");
97	>	}
98	>	}
99	>	}
100	>
101	>	sub tool_()
102	>	{
103	>	delete $self->{levels};
104	>	delete $self->{id};
105	>	delete $self->{nested};
106	>	}
107	>
108	>	sub lib()
109	>	{
110	>	my ($object,$name,%attributes)=@_;
111	>	push(@{$self->{"$self->{levels}->[$self->{nested}]".content}->{LIB}},$attributes{'name'});
112	>	}
113	>
114	>	sub info()
115	>	{
116	>	my ($object,$name,%attributes)=@_;
117	>	$self->{"$self->{levels}->[$self->{nested}]".content}->{INFO} = \%attributes;
118	>	}
119	>
120	>	sub use()
121	>	{
122	>	my ($object,$name,%attributes)=@_;
123	>	push(@{$self->{"$self->{levels}->[$self->{nested}]".content}->{USE}},$attributes{'name'});
124	>	}
125	>
126	>	sub runtime()
127	>	{
128	>	my ($object,$name,%attributes)=@_;
129	>	my $hashref = \%attributes;
130	>	my $envname;
131	>	# Break the value/default value into its constituent parts:
132	>	foreach my $t (qw(value default))
133	>	{
134	>	if (exists ($$hashref{$t}))
135	>	{
136	>	$hashref->{ELEMENTS} = [];
137	>	map
138	>	{
139	>	# In some cases, we might set a runtime path (e.g. LD_LIBRARY_PATH) to
140	>	# a proper path value i.e. X:Y. In this case, don't bother adding the string
141	>	# as a "variable" to ELEMENTS:
142	>	if ($_ =~ m|\$(.*)?| && $_ !~ /:/)
143	>	{
144	>	push(@{$hashref->{ELEMENTS}},$1);
145	>	}
146	>	} split("/",$hashref->{$t});
147	>	}
148	>	}
149
150	<	return $self;
150	>	# Check to see if we have a "type" arg. If so, we use this to create the key:
151	>	if (exists ($hashref->{'type'}))
152	>	{
153	>	my $type=$hashref->{'type'};
154	>	# Make the type uppercase:
155	>	$type =~ tr/[a-z]/[A-Z]/;
156	>	# Rename the environment as "<type>:<env name>":
157	>	$envname = $type.":".$$hashref{'name'};
158	>	}
159	>	else
160	>	{
161	>	$envname = $$hashref{'name'};
162	>	}
163	>
164	>	# Delete name entry so hash is more tidy
165	>	delete $$hashref{'name'};
166	>
167	>	# Before we save $hashref we need to know if there are already
168	>	# any runtime tags with the same name. If there are, we must save all
169	>	# data to an aray of hashes:
170	>	if (exists ($self->{"$self->{levels}->[$self->{nested}]".content}->{RUNTIME}->{$envname}))
171	>	{
172	>	push(@{$self->{"$self->{levels}->[$self->{nested}]".content}->{RUNTIME}->{$envname}},$hashref);
173	>	}
174	>	else
175	>	{
176	>	# No entry yet so just store the hashref:
177	>	$self->{"$self->{levels}->[$self->{nested}]".content}->{RUNTIME}->{$envname} = [ $hashref ];
178	>	}
179		}
180
181	<	sub _initparser
181	>	sub flags()
182		{
183	<	my $self=shift;
183	>	my ($object,$name,%attributes)=@_;
184	>	# Extract the flag name and its value:
185	>	my ($flagname,$flagvaluestring) = each %attributes;
186	>	$flagname =~ tr/[a-z]/[A-Z]/; # Keep flag name uppercase
187	>	chomp($flagvaluestring);
188	>	# Split the value on whitespace so we can push all
189	>	# individual flags into an array:
190	>	my @flagvalues = split(' ',$flagvaluestring);
191	>
192	>	# Is current tag within another tag block?
193	>	if ($self->{nested} > 0)
194	>	{
195	>	# Check to see if the current flag name is already stored in the hash. If so,
196	>	# just add the new values to the array of flag values:
197	>	if (exists ($self->{"$self->{levels}->[$self->{nested}]".content}->{FLAGS}->{$flagname}))
198	>	{
199	>	push(@{$self->{"$self->{levels}->[$self->{nested}]".content}->{FLAGS}->{$flagname}},@flagvalues);
200	>	}
201	>	else
202	>	{
203	>	$self->{"$self->{levels}->[$self->{nested}]".content}->{FLAGS}->{$flagname} = [ @flagvalues ];
204	>	}
205	>	}
206	>	else
207	>	{
208	>	if (exists ($self->{content}->{FLAGS}->{$flagname}))
209	>	{
210	>	push(@{$self->{content}->{FLAGS}->{$flagname}},@flagvalues);
211	>	}
212	>	else
213	>	{
214	>	$self->{content}->{FLAGS}->{$flagname} = [ @flagvalues ];
215	>	}
216	>	}
217	>	}
218	>
219	>	sub client()
220	>	{
221	>	$self->pushlevel();
222	>	}
223	>
224	>	sub client_()
225	>	{
226	>	if ($self->{isarch} == 1)
227	>	{
228	>	# If we already have an architecture tag, we must write to tagcontent hash:
229	>	$self->{tagcontent}->{CLIENT}=$self->{nexttagcontent};
230	>	delete $self->{nexttagcontent};
231	>	}
232	>	else
233	>	{
234	>	$self->{content}->{CLIENT}=$self->{tagcontent};
235	>	}
236
237	<	$self->{simpledoc}=ActiveDoc::SimpleDoc->new();
238	<	$self->{simpledoc}->newparse("setup");
239	<	$self->{simpledoc}->addtag("setup","Tool",
240	<	\&BuildSystem::ToolTagUtils::tooltagOpen, $self,
241	<	"", $self,
242	<	\&BuildSystem::ToolTagUtils::tooltagClose, $self);
243	<
244	<	$self->{simpledoc}->addtag("setup","Lib",
245	<	\&BuildSystem::ToolTagUtils::libtagOpen, $self,
246	<	"", $self,
247	<	"", $self);
248	<
249	<	$self->{simpledoc}->addtag("setup","info",
250	<	\&BuildSystem::ToolTagUtils::infotagOpen, $self,
251	<	"", $self,
252	<	"", $self);
253	<
254	<	$self->{simpledoc}->addtag("setup","Use",
255	<	\&BuildSystem::ToolTagUtils::usetagOpen, $self,
256	<	"", $self,
257	<	"", $self);
258	<
259	<	$self->{simpledoc}->addtag("setup","Runtime",
260	<	\&BuildSystem::ToolTagUtils::runtimetagOpen, $self,
261	<	"", $self,
82	<	"", $self);
83	<
84	<	$self->{simpledoc}->addtag("setup","Flags",
85	<	\&BuildSystem::ToolTagUtils::flagstagOpen, $self,
86	<	"", $self,
87	<	"", $self);
88	<
89	<	$self->{simpledoc}->addtag("setup","Client",
90	<	\&BuildSystem::ToolTagUtils::clienttagOpen, $self,
91	<	"", $self,
92	<	\&BuildSystem::ToolTagUtils::clienttagClose, $self);
93	<
94	<	$self->{simpledoc}->addtag("setup","Environment",
95	<	\&BuildSystem::ToolTagUtils::environmenttagOpen, $self,
96	<	"", $self,
97	<	"", $self);
98	<
99	<	$self->{simpledoc}->addtag("setup","Makefile",
100	<	\&BuildSystem::ToolTagUtils::makefiletagOpen, $self,
101	<	\&BuildSystem::ToolTagUtils::makefiletagContent, $self,
102	<	\&BuildSystem::ToolTagUtils::makefiletagClose, $self);
103	<
104	<	$self->{simpledoc}->grouptag("Tool","setup");
105	<	$self->{simpledoc}->addtag("setup","Architecture",
106	<	\&BuildSystem::ToolTagUtils::archtagOpen,$self,
107	<	"", $self,
108	<	\&BuildSystem::ToolTagUtils::archtagClose,$self);
237	>	$self->poplevel();
238	>	}
239	>
240	>	sub environment()
241	>	{
242	>	my ($object,$name,%attributes)=@_;
243	>	my $hashref = \%attributes;
244	>	# Save a copy of the name of this environment:
245	>	my $envname=$$hashref{'name'};
246	>	delete $$hashref{'name'}; # Delete name entry so hash is more tidy
247	>	# Break the value/default value into its constituent parts:
248	>	foreach my $t (qw(value default))
249	>	{
250	>	if (exists ($$hashref{$t}))
251	>	{
252	>	$hashref->{ELEMENTS} = [];
253	>	map
254	>	{
255	>	if ($_ =~ m|\$(.*)?|)
256	>	{
257	>	push(@{$hashref->{ELEMENTS}},$1);
258	>	}
259	>	} split("/",$hashref->{$t});
260	>	}
261	>	}
262
263	+	# Before we save $hashref we need to know if there are already
264	+	# any env tags with the same name. If there are, we must save all
265	+	# data to an aray of hashes:
266	+	if (exists ($self->{"$self->{levels}->[$self->{nested}]".content}->{ENVIRONMENT}->{$envname}))
267	+	{
268	+	push(@{$self->{"$self->{levels}->[$self->{nested}]".content}->{ENVIRONMENT}->{$envname}},$hashref);
269	+	}
270	+	else
271	+	{
272	+	# No entry yet so just store the hashref:
273	+	$self->{"$self->{levels}->[$self->{nested}]".content}->{ENVIRONMENT}->{$envname} = [ $hashref ];
274	+	}
275		}
276
277	+	sub makefile()
278	+	{
279	+	my ($object,$name,%attributes)=@_;
280	+	# Set our own Char handler so we can collect the content
281	+	# of the Makefile tag:
282	+	$object->setHandlers(Char => \&makefile_content);
283	+	$self->{makefilecontent} = [];
284	+	}
285	+
286	+	sub makefile_content()
287	+	{
288	+	my ($object, @strings) = @_;
289	+	push(@{$self->{makefilecontent}},@strings);
290	+	}
291	+
292	+	sub makefile_()
293	+	{
294	+	my ($object,$name)=@_;
295	+	push(@{$self->{"$self->{levels}->[$self->{nested}]".content}->{MAKEFILE}},
296	+	join('',@{$self->{makefilecontent}}));
297	+	delete $self->{makefilecontent};
298	+	# Unset the Char handler to revert to the default behaviour:
299	+	$object->setHandlers(Char => 0);
300	+	}
301	+
302	+	sub architecture()
303	+	{
304	+	my ($object,$name,%attributes)=@_;
305	+	$self->pushlevel(\%attributes,1); # Set nested to 1;
306	+	}
307	+
308	+	sub architecture_()
309	+	{
310	+	# Need to be able to cope with multiple arch blocks with same arch string:
311	+	if (exists ($self->{content}->{ARCH}->{$self->{id}->{'name'}}))
312	+	{
313	+	# Already have an architecture tag for this arch:
314	+	while (my ($k,$v) = each %{$self->{tagcontent}})
315	+	{
316	+	# If this tag (e.g. LIB, USE, MAKEFILE) already exists and (as we know
317	+	# it should be) its data is an ARRAY, push it to the store:
318	+	if (exists ($self->{content}->{ARCH}->{$self->{id}->{'name'}}->{$k}) &&
319	+	ref($v) eq 'ARRAY')
320	+	{
321	+	push(@{$self->{content}->{ARCH}->{$self->{id}->{'name'}}->{$k}},@$v);
322	+	}
323	+	else
324	+	{
325	+	# Otherwise (for HASH data) we just store it. Note that, because we do
326	+	# not loop over the HASH content and check for already existsing keys,
327	+	# if two arch blocks with same arch name define the same tag (e.g, ENV),
328	+	# the last occurrence will be kept (i.e. the two values won't be added
329	+	# to one ENV hash: //FIXME for later....)
330	+	$self->{content}->{ARCH}->{$self->{id}->{'name'}}->{$k} = $v;
331	+	}
332	+	}
333	+	}
334	+	else
335	+	{
336	+	$self->{content}->{ARCH}->{$self->{id}->{'name'}}=$self->{tagcontent};
337	+	}
338	+
339	+	delete $self->{isarch};
340	+	$self->poplevel();
341	+	}
342	+
343		sub parse
344		{
345		my $self=shift;
346	<	my ($tool,$toolver,$file)=@_;
116	<
346	>	my ($tool,$toolver,$file)=@_;
347		$self->{tool}=$tool;
348		$self->{version}=$toolver;
349	<	$self->{simpledoc}->filetoparse($file);
349	>	$self->{scramdoc}->filetoparse($file);
350		$self->verbose("Setup Parse");
351	<	$self->{simpledoc}->parse("setup");
352	<
123	<	delete $self->{simpledoc};
351	>	$self->{scramdoc}->parse("setup");
352	>	delete $self->{scramdoc};
353		return $self;
354		}
355
#	Line 559 | Line 788 | sub find_settings()
788		elsif (exists($ENV{$envname}))
789		{
790		# Nothing to do here:
791	+	push(@$runtime, $envname); # FIX From Shahzad.
792		next;
793		}
794		else
#	Line 930 | Line 1160 | sub _check_system_libs()
1160		return $found;
1161		}
1162
1163	+	sub AUTOLOAD()
1164	+	{
1165	+	my ($xmlparser,$name,%attributes)=@_;
1166	+	return if $AUTOLOAD =~ /::DESTROY$/;
1167	+	my $name=$AUTOLOAD;
1168	+	$name =~ s/.*://;
1169	+	}
1170	+
1171		1;

Diff Legend

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