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->{archs}=[];
   $self->{archflag}=1;
   $self->{scramdoc}->parse("builder",$fhead,$ftail);
   # We're done with the SimpleDoc object so delete it:
   delete $self->{scramdoc};
   delete $self->{archs};
   delete $self->{archflag};
   }

sub classpath()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      return $self->{content}->{CLASSPATH};
      }
   if (!$self->{archflag}){return;}
   $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};
      }
   if (!$self->{archflag}){return;}
   $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)=@_;
   if (!$self->{archflag}){return;}
   $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
      {
      if (!$self->{archflag}){return;}
      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)=@_;
   my $flag=$self->{archflag};
   push @{$self->{archs}},$flag;
   my $arch=$attributes{name};
   if (($flag) && ($ENV{SCRAM_ARCH}!~/$arch/)){$self->{archflag}=0;}
   }

sub architecture_()
   {
   my ($object,$name,%attributes)=@_;
   $self->{archflag}=pop @{$self->{archs}};
   }

sub export()
   {
   my ($object,$name,%attributes)=@_;
   if (!$self->{archflag}){return;}
   $self->pushlevel(); # Set nested to 1;
   }

sub export_()
   {
   my ($object,$name,%attributes)=@_;
   if (!$self->{archflag}){return;}
   $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};      
      }
   if (!$self->{archflag}){return;}
   my $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 makefile()
   {
   my ($object,$name,%attributes)=@_;
   # The getter part:
   if (ref($object) eq __PACKAGE__)
      {
      return $self->{content}->{MAKEFILE};
      }
   }

sub makefile_()
   {
   my ($object,$name,$cdata)=@_;
   if (!$self->{archflag}){return;}
   $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};
      }
   if (!$self->{archflag}){return;}
   # 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 bin()
   {
   my ($object,$name,%attributes) = @_;
   if (!$self->{archflag}){return;}
   $self->pushlevel(\%attributes);# Set nested to 1;
   }

sub bin_()
   {
   my ($object,$name,%attributes) = @_;
   if (!$self->{archflag}){return;}
   # 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) = @_;
   if (!$self->{archflag}){return;}
   $self->pushlevel(\%attributes);# Set nested to 1;
   }

sub library_()
   {
   my ($object,$name,%attributes) = @_;
   if (!$self->{archflag}){return;}
   # 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.37
Committed:	Thu Apr 26 07:55:35 2012 UTC (13 years ago) by muzaffar
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V2_2_5_pre2, V2_2_5_pre1, V2_2_4, V2_2_4_pre9, V2_2_4_pre8, V2_2_4_pre7, V2_2_4_pre6, V2_2_4_pre5, V2_2_4_pre4, HEAD
Changes since 1.36:	+4 -2 lines
Log Message:	do not save un necessary items in ProjectCache.db
#	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.37	$self->{archs}=[];
47			$self->{archflag}=1;
48	muzaffar	1.31	$self->{scramdoc}->parse("builder",$fhead,$ftail);
49	sashby	1.30	# We're done with the SimpleDoc object so delete it:
50			delete $self->{scramdoc};
51	muzaffar	1.37	delete $self->{archs};
52			delete $self->{archflag};
53	sashby	1.30	}
54	sashby	1.26
55	sashby	1.30	sub classpath()
56			{
57			my ($object,$name,%attributes)=@_;
58			# The getter part:
59			if (ref($object) eq __PACKAGE__)
60			{
61			return $self->{content}->{CLASSPATH};
62			}
63	muzaffar	1.35	if (!$self->{archflag}){return;}
64	sashby	1.30	$self->{nested} == 1 ? push(@{$self->{tagcontent}->{CLASSPATH}}, $attributes{'path'})
65			: push(@{$self->{content}->{CLASSPATH}}, $attributes{'path'});
66	sashby	1.26	}
67	williamc	1.2
68	sashby	1.30	sub productstore()
69			{
70			my ($object,$name,%attributes)=@_;
71			# The getter part:
72			if (ref($object) eq __PACKAGE__)
73			{
74			# Return an array of ProductStore hashes:
75			return $self->{content}->{PRODUCTSTORE};
76			}
77	muzaffar	1.35	if (!$self->{archflag}){return;}
78	sashby	1.30	$self->{nested} == 1 ? push(@{$self->{tagcontent}->{PRODUCTSTORE}}, \%attributes)
79			: push(@{$self->{content}->{PRODUCTSTORE}}, \%attributes) ;
80			}
81
82			sub include()
83	sashby	1.19	{
84			my $self=shift;
85	sashby	1.30	# Return an array of required includes:
86			return $self->{content}->{INCLUDE};
87			}
88
89			sub include_path()
90			{
91			my ($object,$name,%attributes)=@_;
92	muzaffar	1.35	if (!$self->{archflag}){return;}
93	sashby	1.30	$self->{nested} == 1 ? push(@{$self->{tagcontent}->{INCLUDE}}, $attributes{'path'})
94			: push(@{$self->{content}->{INCLUDE}}, $attributes{'path'});
95			}
96
97			sub use()
98			{
99			my $object=shift;
100			# The getter part:
101			if (ref($object) eq __PACKAGE__)
102			{
103			# Add or return uses (package deps):
104			@_ ? push(@{$self->{content}->{USE}},@_)
105			: @{$self->{content}->{USE}};
106			}
107			else
108			{
109	muzaffar	1.35	if (!$self->{archflag}){return;}
110	sashby	1.30	my ($name,%attributes)=@_;
111			$self->{DEPENDENCIES}->{$attributes{'name'}} = 1;
112			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{USE}}, $attributes{'name'})
113			: push(@{$self->{content}->{USE}}, $attributes{'name'});
114			}
115			}
116
117			sub architecture()
118			{
119			my ($object,$name,%attributes)=@_;
120	muzaffar	1.35	my $flag=$self->{archflag};
121			push @{$self->{archs}},$flag;
122			my $arch=$attributes{name};
123			if (($flag) && ($ENV{SCRAM_ARCH}!~/$arch/)){$self->{archflag}=0;}
124	sashby	1.30	}
125
126			sub architecture_()
127			{
128	muzaffar	1.35	my ($object,$name,%attributes)=@_;
129			$self->{archflag}=pop @{$self->{archs}};
130	sashby	1.30	}
131
132			sub export()
133			{
134	muzaffar	1.35	my ($object,$name,%attributes)=@_;
135			if (!$self->{archflag}){return;}
136	sashby	1.30	$self->pushlevel(); # Set nested to 1;
137			}
138
139			sub export_()
140			{
141	muzaffar	1.35	my ($object,$name,%attributes)=@_;
142			if (!$self->{archflag}){return;}
143	sashby	1.30	$self->{content}->{EXPORT} = $self->{tagcontent};
144			$self->poplevel();
145			}
146
147			sub lib()
148			{
149			my ($object,$name,%attributes)=@_;
150			# The getter part:
151			if (ref($object) eq __PACKAGE__)
152			{
153			# Return an array of required libs:
154			return $self->{content}->{LIB};
155			}
156	muzaffar	1.35	if (!$self->{archflag}){return;}
157	muzaffar	1.36	my $libname = $attributes{'name'};
158	sashby	1.30	# We have a libname, add it to the list:
159			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIB}}, $libname)
160			: push(@{$self->{content}->{LIB}}, $libname);
161			}
162
163			sub makefile()
164			{
165			my ($object,$name,%attributes)=@_;
166			# The getter part:
167			if (ref($object) eq __PACKAGE__)
168			{
169			return $self->{content}->{MAKEFILE};
170			}
171			}
172
173			sub makefile_()
174			{
175	muzaffar	1.33	my ($object,$name,$cdata)=@_;
176	muzaffar	1.35	if (!$self->{archflag}){return;}
177	muzaffar	1.33	$self->{nested} == 1 ? push(@{$self->{tagcontent}->{MAKEFILE}}, join("\n",@$cdata))
178			: push(@{$self->{content}->{MAKEFILE}}, join("\n",@$cdata));
179	sashby	1.30	}
180
181			sub flags()
182			{
183			my ($object,$name,%attributes)=@_;
184			# The getter part:
185			if (ref($object) eq __PACKAGE__)
186			{
187			# Return an array of ProductStore hashes:
188			return $self->{content}->{FLAGS};
189			}
190	muzaffar	1.35	if (!$self->{archflag}){return;}
191	sashby	1.30	# Extract the flag name and its value:
192			my ($flagname,$flagvaluestring) = each %attributes;
193			$flagname =~ tr/[a-z]/[A-Z]/; # Keep flag name uppercase
194			chomp($flagvaluestring);
195	muzaffar	1.31	my @flagvalues = ( $flagvaluestring );
196	sashby	1.30	# Is current tag within another tag block?
197			if ($self->{nested} == 1)
198			{
199			# Check to see if the current flag name is already stored in the hash. If so,
200			# just add the new values to the array of flag values:
201			if (exists ($self->{tagcontent}->{FLAGS}->{$flagname}))
202			{
203			push(@{$self->{tagcontent}->{FLAGS}->{$flagname}},@flagvalues);
204			}
205			else
206			{
207			$self->{tagcontent}->{FLAGS}->{$flagname} = [ @flagvalues ];
208			}
209			}
210			else
211			{
212			if (exists ($self->{content}->{FLAGS}->{$flagname}))
213			{
214			push(@{$self->{content}->{FLAGS}->{$flagname}},@flagvalues);
215			}
216			else
217			{
218			$self->{content}->{FLAGS}->{$flagname} = [ @flagvalues ];
219			}
220			}
221			}
222	sashby	1.26
223	sashby	1.30	sub allflags()
224			{
225			my $self=shift;
226			# Return hash data for flags:
227			return $self->{content}->{FLAGS};
228	sashby	1.19	}
229	williamc	1.2
230	sashby	1.30	sub bin()
231			{
232			my ($object,$name,%attributes) = @_;
233	muzaffar	1.35	if (!$self->{archflag}){return;}
234	sashby	1.30	$self->pushlevel(\%attributes);# Set nested to 1;
235			}
236
237			sub bin_()
238			{
239	muzaffar	1.35	my ($object,$name,%attributes) = @_;
240			if (!$self->{archflag}){return;}
241	sashby	1.30	# Need unique name for the binary (always use name of product). Either use "name"
242			# given, or use "file" value minus the ending:
243			if (exists ($self->{id}->{'name'}))
244			{
245			$name = $self->{id}->{'name'};
246			}
247			else
248			{
249			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
250			}
251	sashby	1.26
252	sashby	1.30	# Store the data:
253			$self->productcollector($name,'bin','BIN');
254			$self->poplevel();
255			}
256
257			sub library()
258			{
259			my ($object,$name,%attributes) = @_;
260	muzaffar	1.35	if (!$self->{archflag}){return;}
261	sashby	1.30	$self->pushlevel(\%attributes);# Set nested to 1;
262			}
263
264			sub library_()
265			{
266	muzaffar	1.35	my ($object,$name,%attributes) = @_;
267			if (!$self->{archflag}){return;}
268	sashby	1.30	# Need unique name for the library (always use name of product). Either use "name"
269			# given, or use "file" value minus the ending:
270			if (exists ($self->{id}->{'name'}))
271			{
272			$name = $self->{id}->{'name'};
273			}
274			else
275			{
276			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
277			}
278
279			# Store the data:
280			$self->productcollector($name,'lib','LIBRARY');
281			$self->poplevel();
282			}
283
284	sashby	1.26	sub productcollector()
285	sashby	1.23	{
286			my $self=shift;
287	sashby	1.26	my ($name,$typeshort,$typefull)=@_;
288			# Create a new Product object for storage of data:
289			use BuildSystem::Product;
290			my $product = BuildSystem::Product->new();
291			# Store the name:
292			$product->name($name);
293			$product->type($typeshort);
294	sashby	1.30	# Store the files. Take the BuildFile path as the initial path for
295			# expanding source file globs:
296			$product->_files($self->{id}->{'file'},[ $self->{scramdoc}->filetoparse() ]);
297	sashby	1.26	# Store the data content:
298			$product->_data($self->{tagcontent});
299			# And store in a hash (all build products in same place):
300			$self->{content}->{BUILDPRODUCTS}->{$typefull}->{$name} = $product;
301	sashby	1.23	}
302	williamc	1.1
303	sashby	1.26	sub pushlevel
304	sashby	1.17	{
305	sashby	1.26	my $self = shift;
306			my ($info)=@_;
307	sashby	1.17
308	sashby	1.26	$self->{id} = $info if (defined $info);
309			$self->{nested} = 1;
310			$self->{tagcontent}={};
311			}
312	sashby	1.15
313	sashby	1.26	sub poplevel
314			{
315			my $self = shift;
316			delete $self->{id};
317			delete $self->{nested};
318			delete $self->{tagcontent};
319	sashby	1.17	}
320	williamc	1.2
321	sashby	1.26	sub dependencies()
322	sashby	1.19	{
323			my $self=shift;
324	sashby	1.26	# Make a copy of the variable so that
325			# we don't have a DEPENDENCIES entry in RAWDATA:
326			my %DEPS=%{$self->{DEPENDENCIES}};
327			delete $self->{DEPENDENCIES};
328			return \%DEPS;
329	sashby	1.19	}
330
331	sashby	1.28	sub skippeddirs()
332			{
333			my $self=shift;
334			my ($here)=@_;
335			my $skipped;
336
337			if ($self->{content}->{SKIPPEDDIRS}->[0] == 1)
338			{
339			$skipped = [ @{$self->{content}->{SKIPPEDDIRS}} ];
340			delete $self->{content}->{SKIPPEDDIRS};
341			}
342
343			delete $self->{content}->{SKIPPEDDIRS};
344			return $skipped;
345			}
346
347	sashby	1.30	sub hasexport()
348			{
349			my $self=shift;
350			# Check to see if there is a valid export block:
351			my $nkeys = $self->exporteddatatypes();
352			$nkeys > 0 ? return 1 : return 0;
353			}
354
355			sub has()
356			{
357			my $self=shift;
358			my ($datatype)=@_;
359			(exists ($self->{content}->{$datatype})) ? return 1 : return 0;
360			}
361
362			sub exported()
363			{
364			my $self=shift;
365			# Return a hash. Keys are type of data provided:
366			return ($self->{content}->{EXPORT});
367			}
368
369			sub exporteddatatypes()
370			{
371			my $self=shift;
372			# Return exported data types:
373			return keys %{$self->{content}->{EXPORT}};
374			}
375
376			sub buildproducts()
377			{
378			my $self=shift;
379			# Returns hash of build products and their data:
380			return $self->{content}->{BUILDPRODUCTS};
381			}
382
383			sub values()
384			{
385			my $self=shift;
386			my ($type)=@_;
387			# Get a list of values from known types
388			return $self->{content}->{BUILDPRODUCTS}->{$type};
389			}
390
391			sub basic_tags()
392			{
393			my $self=shift;
394			my $datatags=[];
395	muzaffar	1.33	my $buildtags=[ qw(BIN LIBRARY BUILDPRODUCTS) ];
396			my $skiptags=[ qw(ARCH EXPORT USE CLASSPATH) ];
397	sashby	1.30	my $otherskiptags=[ qw( SKIPPEDDIRS ) ];
398			my @all_skip_tags;
399
400			push(@all_skip_tags,@$skiptags,@$buildtags,@$otherskiptags);
401
402			foreach my $t (keys %{$self->{content}})
403			{
404			push(@$datatags,$t),if (! grep($t eq $_, @all_skip_tags));
405			}
406			return @{$datatags};
407			}
408
409			sub clean()
410			{
411			my $self=shift;
412			my (@tags) = @_;
413
414			# Delete some useless entries:
415			delete $self->{simpledoc};
416			delete $self->{id};
417			delete $self->{tagcontent};
418			delete $self->{nested};
419
420			delete $self->{DEPENDENCIES};
421
422			map
423			{
424			delete $self->{content}->{$_} if (exists($self->{content}->{$_}));
425			} @tags;
426
427			return $self;
428			}
429
430			sub AUTOLOAD()
431			{
432			my ($xmlparser,$name,%attributes)=@_;
433			return if $AUTOLOAD =~ /::DESTROY$/;
434			my $name=$AUTOLOAD;
435			$name =~ s/.*://;
436			}
437
438	sashby	1.26	1;