src/BuildSystem/BuildFile.pm

#____________________________________________________________________ 
# File: BuildFile.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Copyright: 2003 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::BuildFile;
require 5.004;
use Exporter;
use ActiveDoc::SimpleDoc;

@ISA=qw(Exporter);
@EXPORT_OK=qw( );
#
sub new()
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Wed Dec  3 19:03:22 2003 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   {
   my $proto=shift;
   my $class=ref($proto) || $proto;
   $self={};
   bless $self,$class;
   $self->{DEPENDENCIES} = {};
   $self->{content} = {};
   $self->{scramdoc}=ActiveDoc::SimpleDoc->new();
   $self->{scramdoc}->newparse("builder",__PACKAGE__,'Subs',shift);
   return $self;
   }

sub parse()
   {
   my $self=shift;
   my ($filename)=@_;
   my $fhead='<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::BuildFile" version="1.0">';
   my $ftail='</doc>';
   $self->{scramdoc}->filetoparse($filename);
   $self->{scramdoc}->parse("builder",$fhead,$ftail);
   # We're done with the SimpleDoc object so delete it:
   delete $self->{scramdoc};
   }

sub classpath()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      return $self->{content}->{CLASSPATH};
      }
   
   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{CLASSPATH}}, $attributes{'path'})
      : push(@{$self->{content}->{CLASSPATH}}, $attributes{'path'});
   }

sub productstore()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      # Return an array of ProductStore hashes:
      return $self->{content}->{PRODUCTSTORE};
      }
   
   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{PRODUCTSTORE}}, \%attributes)
      : push(@{$self->{content}->{PRODUCTSTORE}}, \%attributes) ;
   }

sub include()
   {
   my $self=shift;
   # Return an array of required includes:
   return $self->{content}->{INCLUDE};
   }

sub include_path()
   {
   my ($object,$name,%attributes)=@_;
   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{INCLUDE}}, $attributes{'path'})
      : push(@{$self->{content}->{INCLUDE}}, $attributes{'path'});
   }

sub use()
   {
   my $object=shift;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      # Add or return uses (package deps):
      @_ ? push(@{$self->{content}->{USE}},@_)
         : @{$self->{content}->{USE}};
      }
   else
      {
      my ($name,%attributes)=@_;
      $self->{DEPENDENCIES}->{$attributes{'name'}} = 1;
      $self->{nested} == 1 ? push(@{$self->{tagcontent}->{USE}}, $attributes{'name'})
         : push(@{$self->{content}->{USE}}, $attributes{'name'});
      }
   }

sub architecture()
   {
   my ($object,$name,%attributes)=@_;
   $self->pushlevel(\%attributes); # Set nested to 1;
   }

sub architecture_()
   {
   $self->{content}->{ARCH}->{$self->{id}->{'name'}}=$self->{tagcontent};
   $self->poplevel();
   }

sub export()
   {
   $self->pushlevel(); # Set nested to 1;
   }

sub export_()
   {
   $self->{content}->{EXPORT} = $self->{tagcontent};
   $self->poplevel();
   }

sub lib()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      # Return an array of required libs:
      return $self->{content}->{LIB};      
      }
   
   my $libname;
   
   if (exists($attributes{'position'}))
      {
      if ($attributes{'position'} eq 'first')
         {
         $libname = "F:".$attributes{'name'};
         }
      else
         {
         # There was a position entry but it didn't make sense:
         $libname = $attributes{'name'};
         }
      }
   else
      {
      $libname = $attributes{'name'};
      }
   # We have a libname, add it to the list:
   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIB}}, $libname)
      : push(@{$self->{content}->{LIB}}, $libname);
   }

sub libtype()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      # Return an array of required libs:
      return $self->{content}->{LIBTYPE};      
      }

   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIBTYPE}}, $attributes{'type'})
      : push(@{$self->{content}->{LIBTYPE}}, $attributes{'type'});
   }

sub skip()
   {
   my ($object,$name,%attributes)=@_;
   $self->{nested} == 1 ? $self->{tagcontent}->{SKIPPEDDIRS} = [ 1 ]
      : $self->{content}->{SKIPPEDDIRS} = [ 1 ];
   }

sub skip_message()
   {
   my ($object,$name,@message) = @_;
   # Save any message text between <skip> tags:
   if ($#message > -1)
      {
      $self->{nested} == 1 ? push(@{$self->{tagcontent}->{SKIPPEDDIRS}}, [ @message ])
         : push(@{$self->{content}->{SKIPPEDDIRS}}, [ @message ]);
      }
   }

sub skip_()
   {
   my ($object,$name)=@_;
   }

sub makefile()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      return $self->{content}->{MAKEFILE};
      }
   }

sub makefile_()
   {
   my ($object,$name,$cdata)=@_;
   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{MAKEFILE}}, join("\n",@$cdata))
      : push(@{$self->{content}->{MAKEFILE}}, join("\n",@$cdata));
   }

sub flags()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      # Return an array of ProductStore hashes:
      return $self->{content}->{FLAGS};
      }
   
   # Extract the flag name and its value:
   my ($flagname,$flagvaluestring) = each %attributes;
   $flagname =~ tr/[a-z]/[A-Z]/; # Keep flag name uppercase
   chomp($flagvaluestring);
   my @flagvalues = ( $flagvaluestring );
   # Is current tag within another tag block?
   if ($self->{nested} == 1)
      {
      # Check to see if the current flag name is already stored in the hash. If so,
      # just add the new values to the array of flag values:
      if (exists ($self->{tagcontent}->{FLAGS}->{$flagname}))
         {
         push(@{$self->{tagcontent}->{FLAGS}->{$flagname}},@flagvalues);
         }
      else
         {
         $self->{tagcontent}->{FLAGS}->{$flagname} = [ @flagvalues ];
         }
      }
   else
      {
      if (exists ($self->{content}->{FLAGS}->{$flagname}))
         {
         push(@{$self->{content}->{FLAGS}->{$flagname}},@flagvalues);
         }
      else
         {
         $self->{content}->{FLAGS}->{$flagname} = [ @flagvalues ];
         }
      }
   }

sub allflags()
   {
   my $self=shift;
   # Return hash data for flags:
   return $self->{content}->{FLAGS};
   }

sub archspecific()
   {
   my $self=shift;
   
   # Check to see if there is arch-dependent data. If so, return it:
   if ((my $nkeys=keys %{$self->{content}->{ARCH}}) > 0)
      {
      while (my ($k,$v) = each %{$self->{content}->{ARCH}})
         {
         if ( $ENV{SCRAM_ARCH} =~ /$k.*/ )
            {
            return $self->{content}->{ARCH}->{$k};
            }
         }
      }
   return "";
   }

sub bin()
   {
   my ($object,$name,%attributes) = @_;
   $self->pushlevel(\%attributes);# Set nested to 1;
   }

sub bin_()
   {
   # Need unique name for the binary (always use name of product). Either use "name"
   # given, or use "file" value minus the ending:
   if (exists ($self->{id}->{'name'}))
      {
      $name = $self->{id}->{'name'};
      }
   else
      {
      ($name) = ($self->{id}->{'file'} =~ /(.*)?\..*$/);
      }

   # Store the data:
   $self->productcollector($name,'bin','BIN');
   $self->poplevel();
   }

sub library()
   {
   my ($object,$name,%attributes) = @_;
   $self->pushlevel(\%attributes);# Set nested to 1;
   }

sub library_()
   {
   # Need unique name for the library (always use name of product). Either use "name"
   # given, or use "file" value minus the ending:
   if (exists ($self->{id}->{'name'}))
      {
      $name = $self->{id}->{'name'};
      }
   else
      {
      ($name) = ($self->{id}->{'file'} =~ /(.*)?\..*$/);
      }

   # Store the data:
   $self->productcollector($name,'lib','LIBRARY');
   $self->poplevel();
   }

sub productcollector()
   {
   my $self=shift;
   my ($name,$typeshort,$typefull)=@_;
   # Create a new Product object for storage of data:
   use BuildSystem::Product;
   my $product = BuildSystem::Product->new();
   # Store the name:
   $product->name($name);
   $product->type($typeshort);
   # Store the files. Take the BuildFile path as the initial path for
   # expanding source file globs:
   $product->_files($self->{id}->{'file'},[ $self->{scramdoc}->filetoparse() ]);
   # Store the data content:
   $product->_data($self->{tagcontent});
   # And store in a hash (all build products in same place):
   $self->{content}->{BUILDPRODUCTS}->{$typefull}->{$name} = $product;
   }

sub pushlevel
   {
   my $self = shift;
   my ($info)=@_;
   
   $self->{id} = $info if (defined $info);
   $self->{nested} = 1;
   $self->{tagcontent}={};
   }

sub poplevel
   {
   my $self = shift;
   delete $self->{id};
   delete $self->{nested};
   delete $self->{tagcontent};
   }

sub dependencies()
   {
   my $self=shift;
   # Make a copy of the variable so that
   # we don't have a DEPENDENCIES entry in RAWDATA:
   my %DEPS=%{$self->{DEPENDENCIES}};
   delete $self->{DEPENDENCIES};
   return \%DEPS;
   }

sub skippeddirs()
   {
   my $self=shift;
   my ($here)=@_;
   my $skipped;

   if ($self->{content}->{SKIPPEDDIRS}->[0] == 1)
      {
      $skipped = [ @{$self->{content}->{SKIPPEDDIRS}} ];
      delete $self->{content}->{SKIPPEDDIRS};
      }
   
   delete $self->{content}->{SKIPPEDDIRS};
   return $skipped;
   }

sub hasexport()
   {
   my $self=shift;
   # Check to see if there is a valid export block:
   my $nkeys = $self->exporteddatatypes();
   $nkeys > 0 ? return 1 : return 0;
   }

sub has()
   {
   my $self=shift;
   my ($datatype)=@_;   
   (exists ($self->{content}->{$datatype})) ? return 1 : return 0;
   }

sub exported()
   {
   my $self=shift;
   # Return a hash. Keys are type of data provided:
   return ($self->{content}->{EXPORT});
   }

sub exporteddatatypes()
   {
   my $self=shift;
   # Return exported data types:
   return keys %{$self->{content}->{EXPORT}};
   }

sub buildproducts()
   {
   my $self=shift;
   # Returns hash of build products and their data:
   return $self->{content}->{BUILDPRODUCTS};
   }

sub values()
   {
   my $self=shift;
   my ($type)=@_;
   # Get a list of values from known types
   return $self->{content}->{BUILDPRODUCTS}->{$type};
   }

sub basic_tags()
   {
   my $self=shift;
   my $datatags=[];
   my $buildtags=[ qw(BIN LIBRARY BUILDPRODUCTS) ];
   my $skiptags=[ qw(ARCH EXPORT USE CLASSPATH) ];
   my $otherskiptags=[ qw( SKIPPEDDIRS ) ];
   my @all_skip_tags;
   
   push(@all_skip_tags,@$skiptags,@$buildtags,@$otherskiptags);

   foreach my $t (keys %{$self->{content}})
      {
      push(@$datatags,$t),if (! grep($t eq $_, @all_skip_tags));
      }
   return @{$datatags};
   }

sub clean()
   {
   my $self=shift;
   my (@tags) = @_;

   # Delete some useless entries:
   delete $self->{simpledoc};
   delete $self->{id};
   delete $self->{tagcontent};
   delete $self->{nested};

   delete $self->{DEPENDENCIES};
   
   map
      {
      delete $self->{content}->{$_} if (exists($self->{content}->{$_}));
      } @tags;
   
   return $self;
   }

sub AUTOLOAD()
   {
   my ($xmlparser,$name,%attributes)=@_;
   return if $AUTOLOAD =~ /::DESTROY$/;
   my $name=$AUTOLOAD;
   $name =~ s/.*://;
   }

1;
Revision:	1.34
Committed:	Tue Oct 18 14:59:26 2011 UTC (13 years, 6 months ago) by muzaffar
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V2_2_4_pre3, V2_2_4_pre2, V2_2_4_pre1
Changes since 1.33:	+0 -3 lines
Log Message:	removed cvs $id statement
#	User	Rev	Content
1	sashby	1.26	#____________________________________________________________________
2			# File: BuildFile.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Copyright: 2003 (C) Shaun Ashby
7			#
8			#--------------------------------------------------------------------
9	williamc	1.1	package BuildSystem::BuildFile;
10	sashby	1.26	require 5.004;
11			use Exporter;
12	williamc	1.2	use ActiveDoc::SimpleDoc;
13
14	sashby	1.30	@ISA=qw(Exporter);
15	sashby	1.26	@EXPORT_OK=qw( );
16			#
17			sub new()
18			###############################################################
19			# new #
20			###############################################################
21			# modified : Wed Dec 3 19:03:22 2003 / SFA #
22			# params : #
23			# : #
24			# function : #
25			# : #
26			###############################################################
27			{
28			my $proto=shift;
29			my $class=ref($proto) \|\| $proto;
30	sashby	1.30	$self={};
31	sashby	1.26	bless $self,$class;
32			$self->{DEPENDENCIES} = {};
33			$self->{content} = {};
34	sashby	1.30	$self->{scramdoc}=ActiveDoc::SimpleDoc->new();
35	muzaffar	1.33	$self->{scramdoc}->newparse("builder",__PACKAGE__,'Subs',shift);
36	sashby	1.26	return $self;
37			}
38
39	sashby	1.30	sub parse()
40	sashby	1.26	{
41			my $self=shift;
42	sashby	1.30	my ($filename)=@_;
43	muzaffar	1.31	my $fhead='<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::BuildFile" version="1.0">';
44			my $ftail='</doc>';
45	sashby	1.30	$self->{scramdoc}->filetoparse($filename);
46	muzaffar	1.31	$self->{scramdoc}->parse("builder",$fhead,$ftail);
47	sashby	1.30	# We're done with the SimpleDoc object so delete it:
48			delete $self->{scramdoc};
49			}
50	sashby	1.26
51	sashby	1.30	sub classpath()
52			{
53			my ($object,$name,%attributes)=@_;
54			# The getter part:
55			if (ref($object) eq __PACKAGE__)
56			{
57			return $self->{content}->{CLASSPATH};
58			}
59
60			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{CLASSPATH}}, $attributes{'path'})
61			: push(@{$self->{content}->{CLASSPATH}}, $attributes{'path'});
62	sashby	1.26	}
63	williamc	1.2
64	sashby	1.30	sub productstore()
65			{
66			my ($object,$name,%attributes)=@_;
67			# The getter part:
68			if (ref($object) eq __PACKAGE__)
69			{
70			# Return an array of ProductStore hashes:
71			return $self->{content}->{PRODUCTSTORE};
72			}
73
74			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{PRODUCTSTORE}}, \%attributes)
75			: push(@{$self->{content}->{PRODUCTSTORE}}, \%attributes) ;
76			}
77
78			sub include()
79	sashby	1.19	{
80			my $self=shift;
81	sashby	1.30	# Return an array of required includes:
82			return $self->{content}->{INCLUDE};
83			}
84
85			sub include_path()
86			{
87			my ($object,$name,%attributes)=@_;
88			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{INCLUDE}}, $attributes{'path'})
89			: push(@{$self->{content}->{INCLUDE}}, $attributes{'path'});
90			}
91
92			sub use()
93			{
94			my $object=shift;
95			# The getter part:
96			if (ref($object) eq __PACKAGE__)
97			{
98			# Add or return uses (package deps):
99			@_ ? push(@{$self->{content}->{USE}},@_)
100			: @{$self->{content}->{USE}};
101			}
102			else
103			{
104			my ($name,%attributes)=@_;
105			$self->{DEPENDENCIES}->{$attributes{'name'}} = 1;
106			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{USE}}, $attributes{'name'})
107			: push(@{$self->{content}->{USE}}, $attributes{'name'});
108			}
109			}
110
111			sub architecture()
112			{
113			my ($object,$name,%attributes)=@_;
114			$self->pushlevel(\%attributes); # Set nested to 1;
115			}
116
117			sub architecture_()
118			{
119			$self->{content}->{ARCH}->{$self->{id}->{'name'}}=$self->{tagcontent};
120			$self->poplevel();
121			}
122
123			sub export()
124			{
125			$self->pushlevel(); # Set nested to 1;
126			}
127
128			sub export_()
129			{
130			$self->{content}->{EXPORT} = $self->{tagcontent};
131			$self->poplevel();
132			}
133
134			sub lib()
135			{
136			my ($object,$name,%attributes)=@_;
137			# The getter part:
138			if (ref($object) eq __PACKAGE__)
139			{
140			# Return an array of required libs:
141			return $self->{content}->{LIB};
142			}
143
144			my $libname;
145
146			if (exists($attributes{'position'}))
147			{
148			if ($attributes{'position'} eq 'first')
149			{
150			$libname = "F:".$attributes{'name'};
151			}
152			else
153			{
154			# There was a position entry but it didn't make sense:
155			$libname = $attributes{'name'};
156			}
157			}
158			else
159			{
160			$libname = $attributes{'name'};
161			}
162			# We have a libname, add it to the list:
163			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIB}}, $libname)
164			: push(@{$self->{content}->{LIB}}, $libname);
165			}
166
167			sub libtype()
168			{
169			my ($object,$name,%attributes)=@_;
170			# The getter part:
171			if (ref($object) eq __PACKAGE__)
172			{
173			# Return an array of required libs:
174			return $self->{content}->{LIBTYPE};
175			}
176
177			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIBTYPE}}, $attributes{'type'})
178			: push(@{$self->{content}->{LIBTYPE}}, $attributes{'type'});
179			}
180
181			sub skip()
182			{
183			my ($object,$name,%attributes)=@_;
184			$self->{nested} == 1 ? $self->{tagcontent}->{SKIPPEDDIRS} = [ 1 ]
185			: $self->{content}->{SKIPPEDDIRS} = [ 1 ];
186			}
187
188			sub skip_message()
189			{
190			my ($object,$name,@message) = @_;
191			# Save any message text between <skip> tags:
192			if ($#message > -1)
193			{
194			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{SKIPPEDDIRS}}, [ @message ])
195			: push(@{$self->{content}->{SKIPPEDDIRS}}, [ @message ]);
196			}
197			}
198
199			sub skip_()
200			{
201			my ($object,$name)=@_;
202			}
203
204			sub makefile()
205			{
206			my ($object,$name,%attributes)=@_;
207			# The getter part:
208			if (ref($object) eq __PACKAGE__)
209			{
210			return $self->{content}->{MAKEFILE};
211			}
212			}
213
214			sub makefile_()
215			{
216	muzaffar	1.33	my ($object,$name,$cdata)=@_;
217			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{MAKEFILE}}, join("\n",@$cdata))
218			: push(@{$self->{content}->{MAKEFILE}}, join("\n",@$cdata));
219	sashby	1.30	}
220
221			sub flags()
222			{
223			my ($object,$name,%attributes)=@_;
224			# The getter part:
225			if (ref($object) eq __PACKAGE__)
226			{
227			# Return an array of ProductStore hashes:
228			return $self->{content}->{FLAGS};
229			}
230
231			# Extract the flag name and its value:
232			my ($flagname,$flagvaluestring) = each %attributes;
233			$flagname =~ tr/[a-z]/[A-Z]/; # Keep flag name uppercase
234			chomp($flagvaluestring);
235	muzaffar	1.31	my @flagvalues = ( $flagvaluestring );
236	sashby	1.30	# Is current tag within another tag block?
237			if ($self->{nested} == 1)
238			{
239			# Check to see if the current flag name is already stored in the hash. If so,
240			# just add the new values to the array of flag values:
241			if (exists ($self->{tagcontent}->{FLAGS}->{$flagname}))
242			{
243			push(@{$self->{tagcontent}->{FLAGS}->{$flagname}},@flagvalues);
244			}
245			else
246			{
247			$self->{tagcontent}->{FLAGS}->{$flagname} = [ @flagvalues ];
248			}
249			}
250			else
251			{
252			if (exists ($self->{content}->{FLAGS}->{$flagname}))
253			{
254			push(@{$self->{content}->{FLAGS}->{$flagname}},@flagvalues);
255			}
256			else
257			{
258			$self->{content}->{FLAGS}->{$flagname} = [ @flagvalues ];
259			}
260			}
261			}
262	sashby	1.26
263	sashby	1.30	sub allflags()
264			{
265			my $self=shift;
266			# Return hash data for flags:
267			return $self->{content}->{FLAGS};
268	sashby	1.19	}
269	williamc	1.2
270	sashby	1.30	sub archspecific()
271	sashby	1.17	{
272			my $self=shift;
273	sashby	1.30
274			# Check to see if there is arch-dependent data. If so, return it:
275			if ((my $nkeys=keys %{$self->{content}->{ARCH}}) > 0)
276			{
277			while (my ($k,$v) = each %{$self->{content}->{ARCH}})
278			{
279			if ( $ENV{SCRAM_ARCH} =~ /$k.*/ )
280			{
281			return $self->{content}->{ARCH}->{$k};
282			}
283			}
284			}
285			return "";
286			}
287
288			sub bin()
289			{
290			my ($object,$name,%attributes) = @_;
291			$self->pushlevel(\%attributes);# Set nested to 1;
292			}
293
294			sub bin_()
295			{
296			# Need unique name for the binary (always use name of product). Either use "name"
297			# given, or use "file" value minus the ending:
298			if (exists ($self->{id}->{'name'}))
299			{
300			$name = $self->{id}->{'name'};
301			}
302			else
303			{
304			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
305			}
306	sashby	1.26
307	sashby	1.30	# Store the data:
308			$self->productcollector($name,'bin','BIN');
309			$self->poplevel();
310			}
311
312			sub library()
313			{
314			my ($object,$name,%attributes) = @_;
315			$self->pushlevel(\%attributes);# Set nested to 1;
316			}
317
318			sub library_()
319			{
320			# Need unique name for the library (always use name of product). Either use "name"
321			# given, or use "file" value minus the ending:
322			if (exists ($self->{id}->{'name'}))
323			{
324			$name = $self->{id}->{'name'};
325			}
326			else
327			{
328			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
329			}
330
331			# Store the data:
332			$self->productcollector($name,'lib','LIBRARY');
333			$self->poplevel();
334			}
335
336	sashby	1.26	sub productcollector()
337	sashby	1.23	{
338			my $self=shift;
339	sashby	1.26	my ($name,$typeshort,$typefull)=@_;
340			# Create a new Product object for storage of data:
341			use BuildSystem::Product;
342			my $product = BuildSystem::Product->new();
343			# Store the name:
344			$product->name($name);
345			$product->type($typeshort);
346	sashby	1.30	# Store the files. Take the BuildFile path as the initial path for
347			# expanding source file globs:
348			$product->_files($self->{id}->{'file'},[ $self->{scramdoc}->filetoparse() ]);
349	sashby	1.26	# Store the data content:
350			$product->_data($self->{tagcontent});
351			# And store in a hash (all build products in same place):
352			$self->{content}->{BUILDPRODUCTS}->{$typefull}->{$name} = $product;
353	sashby	1.23	}
354	williamc	1.1
355	sashby	1.26	sub pushlevel
356	sashby	1.17	{
357	sashby	1.26	my $self = shift;
358			my ($info)=@_;
359	sashby	1.17
360	sashby	1.26	$self->{id} = $info if (defined $info);
361			$self->{nested} = 1;
362			$self->{tagcontent}={};
363			}
364	sashby	1.15
365	sashby	1.26	sub poplevel
366			{
367			my $self = shift;
368			delete $self->{id};
369			delete $self->{nested};
370			delete $self->{tagcontent};
371	sashby	1.17	}
372	williamc	1.2
373	sashby	1.26	sub dependencies()
374	sashby	1.19	{
375			my $self=shift;
376	sashby	1.26	# Make a copy of the variable so that
377			# we don't have a DEPENDENCIES entry in RAWDATA:
378			my %DEPS=%{$self->{DEPENDENCIES}};
379			delete $self->{DEPENDENCIES};
380			return \%DEPS;
381	sashby	1.19	}
382
383	sashby	1.28	sub skippeddirs()
384			{
385			my $self=shift;
386			my ($here)=@_;
387			my $skipped;
388
389			if ($self->{content}->{SKIPPEDDIRS}->[0] == 1)
390			{
391			$skipped = [ @{$self->{content}->{SKIPPEDDIRS}} ];
392			delete $self->{content}->{SKIPPEDDIRS};
393			}
394
395			delete $self->{content}->{SKIPPEDDIRS};
396			return $skipped;
397			}
398
399	sashby	1.30	sub hasexport()
400			{
401			my $self=shift;
402			# Check to see if there is a valid export block:
403			my $nkeys = $self->exporteddatatypes();
404			$nkeys > 0 ? return 1 : return 0;
405			}
406
407			sub has()
408			{
409			my $self=shift;
410			my ($datatype)=@_;
411			(exists ($self->{content}->{$datatype})) ? return 1 : return 0;
412			}
413
414			sub exported()
415			{
416			my $self=shift;
417			# Return a hash. Keys are type of data provided:
418			return ($self->{content}->{EXPORT});
419			}
420
421			sub exporteddatatypes()
422			{
423			my $self=shift;
424			# Return exported data types:
425			return keys %{$self->{content}->{EXPORT}};
426			}
427
428			sub buildproducts()
429			{
430			my $self=shift;
431			# Returns hash of build products and their data:
432			return $self->{content}->{BUILDPRODUCTS};
433			}
434
435			sub values()
436			{
437			my $self=shift;
438			my ($type)=@_;
439			# Get a list of values from known types
440			return $self->{content}->{BUILDPRODUCTS}->{$type};
441			}
442
443			sub basic_tags()
444			{
445			my $self=shift;
446			my $datatags=[];
447	muzaffar	1.33	my $buildtags=[ qw(BIN LIBRARY BUILDPRODUCTS) ];
448			my $skiptags=[ qw(ARCH EXPORT USE CLASSPATH) ];
449	sashby	1.30	my $otherskiptags=[ qw( SKIPPEDDIRS ) ];
450			my @all_skip_tags;
451
452			push(@all_skip_tags,@$skiptags,@$buildtags,@$otherskiptags);
453
454			foreach my $t (keys %{$self->{content}})
455			{
456			push(@$datatags,$t),if (! grep($t eq $_, @all_skip_tags));
457			}
458			return @{$datatags};
459			}
460
461			sub clean()
462			{
463			my $self=shift;
464			my (@tags) = @_;
465
466			# Delete some useless entries:
467			delete $self->{simpledoc};
468			delete $self->{id};
469			delete $self->{tagcontent};
470			delete $self->{nested};
471
472			delete $self->{DEPENDENCIES};
473
474			map
475			{
476			delete $self->{content}->{$_} if (exists($self->{content}->{$_}));
477			} @tags;
478
479			return $self;
480			}
481
482			sub AUTOLOAD()
483			{
484			my ($xmlparser,$name,%attributes)=@_;
485			return if $AUTOLOAD =~ /::DESTROY$/;
486			my $name=$AUTOLOAD;
487			$name =~ s/.*://;
488			}
489
490	sashby	1.26	1;