src/BuildSystem/BuildFile.pm

#____________________________________________________________________ 
# File: BuildFile.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2003-12-03 19:03:15+0100
# Revision: $Id: BuildFile.pm,v 1.29.4.4 2007/02/27 11:38:39 sashby Exp $ 
#
# 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');
   return $self;
   }

sub parse()
   {
   my $self=shift;
   my ($filename)=@_;
   $self->{scramdoc}->filetoparse($filename);
   $self->{scramdoc}->parse("builder");
   # 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 Makefile content:
      return $self->{content}->{MAKEFILE};
      }
   
   # Set our own Char handler so we can collect the content
   # of the Makefile tag:
   $object->setHandlers(Char => \&makefile_content);
   $self->{makefilecontent} = [];
   }

sub makefile_content()
   {
   my ($object, @strings) = @_;
   push(@{$self->{makefilecontent}},@strings);
   }

sub makefile_()
   {
   my ($object,$name)=@_;
   $self->{nested} == 1 ? push(@{$self->{tagcontent}->{MAKEFILE}}, join('',@{$self->{makefilecontent}}))
      : push(@{$self->{content}->{MAKEFILE}}, join('',@{$self->{makefilecontent}}));
   delete $self->{makefilecontent};
   # Unset the Char handler to revert to the default behaviour:
   $object->setHandlers(Char => 0);
   }

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

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

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

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);
   # Split the value on whitespace so we can push all
   # individual flags into an array:
   my @flagvalues = split(' ',$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 module()
   {
   my ($object,$name,%attributes) = @_;
   $self->pushlevel(\%attributes);# Set nested to 1;
   }

sub module_()
   {
   # Need unique name for the module (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,'mod','MODULE');
   $self->poplevel();
   }

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

sub application_()
   {
   # Need unique name for the application (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,'app','APPLICATION');
   $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 plugin()
   {
   my ($object,$name,%attributes) = @_;
   $self->pushlevel(\%attributes);# Set nested to 1;
   }

sub plugin_()
   {
   # Need unique name for the plugin (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,'plugin','PLUGIN');
   $self->poplevel();
   }

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

sub unittest_()
   {
   # Need unique name for the unittest (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,'unittest','unittest');
   $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 defined_group()
   {
   my $self=shift;

   if (exists($self->{content}->{DEFINED_GROUP}))
      {   
      # Return a list of keys (group names) for defined groups:
      return [ keys %{$self->{content}->{DEFINED_GROUP}} ];
      }
   else
      {
      return 0;
      }
   }

sub dataforgroup()
   {
   my $self=shift;
   my ($groupname)=@_;
   # Return hash containing data for defined group
   # $groupname or return undef: 
   return $self->{content}->{DEFINED_GROUP}->{$groupname};
   }

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 APPLICATION MODULE PLUGIN BUILDPRODUCTS) ];
   my $skiptags=[ qw(DEFINED_GROUP ARCH EXPORT GROUP 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->{makefilecontent};
   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.30
Committed:	Tue Feb 27 11:59:44 2007 UTC (18 years, 2 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_1_0, v110p1, V110p6, V110p5, V110p4, V110p3
Branch point for:	v200branch
Changes since 1.29:	+547 -225 lines
Log Message:	Merged from XML branch to HEAD. Start release prep.
#	User	Rev	Content
1	sashby	1.26	#____________________________________________________________________
2			# File: BuildFile.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2003-12-03 19:03:15+0100
7	sashby	1.30	# Revision: $Id: BuildFile.pm,v 1.29.4.4 2007/02/27 11:38:39 sashby Exp $
8	williamc	1.1	#
9	sashby	1.26	# Copyright: 2003 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12	williamc	1.1	package BuildSystem::BuildFile;
13	sashby	1.26	require 5.004;
14			use Exporter;
15	williamc	1.2	use ActiveDoc::SimpleDoc;
16
17	sashby	1.30	@ISA=qw(Exporter);
18	sashby	1.26	@EXPORT_OK=qw( );
19			#
20			sub new()
21			###############################################################
22			# new #
23			###############################################################
24			# modified : Wed Dec 3 19:03:22 2003 / SFA #
25			# params : #
26			# : #
27			# function : #
28			# : #
29			###############################################################
30			{
31			my $proto=shift;
32			my $class=ref($proto) \|\| $proto;
33	sashby	1.30	$self={};
34	sashby	1.26	bless $self,$class;
35			$self->{DEPENDENCIES} = {};
36			$self->{content} = {};
37	sashby	1.30	$self->{scramdoc}=ActiveDoc::SimpleDoc->new();
38			$self->{scramdoc}->newparse("builder",__PACKAGE__,'Subs');
39	sashby	1.26	return $self;
40			}
41
42	sashby	1.30	sub parse()
43	sashby	1.26	{
44			my $self=shift;
45	sashby	1.30	my ($filename)=@_;
46			$self->{scramdoc}->filetoparse($filename);
47			$self->{scramdoc}->parse("builder");
48			# We're done with the SimpleDoc object so delete it:
49			delete $self->{scramdoc};
50			}
51	sashby	1.26
52	sashby	1.30	sub classpath()
53			{
54			my ($object,$name,%attributes)=@_;
55			# The getter part:
56			if (ref($object) eq __PACKAGE__)
57			{
58			return $self->{content}->{CLASSPATH};
59			}
60
61			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{CLASSPATH}}, $attributes{'path'})
62			: push(@{$self->{content}->{CLASSPATH}}, $attributes{'path'});
63	sashby	1.26	}
64	williamc	1.2
65	sashby	1.30	sub productstore()
66			{
67			my ($object,$name,%attributes)=@_;
68			# The getter part:
69			if (ref($object) eq __PACKAGE__)
70			{
71			# Return an array of ProductStore hashes:
72			return $self->{content}->{PRODUCTSTORE};
73			}
74
75			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{PRODUCTSTORE}}, \%attributes)
76			: push(@{$self->{content}->{PRODUCTSTORE}}, \%attributes) ;
77			}
78
79			sub include()
80	sashby	1.19	{
81			my $self=shift;
82	sashby	1.30	# Return an array of required includes:
83			return $self->{content}->{INCLUDE};
84			}
85
86			sub include_path()
87			{
88			my ($object,$name,%attributes)=@_;
89			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{INCLUDE}}, $attributes{'path'})
90			: push(@{$self->{content}->{INCLUDE}}, $attributes{'path'});
91			}
92
93			sub use()
94			{
95			my $object=shift;
96			# The getter part:
97			if (ref($object) eq __PACKAGE__)
98			{
99			# Add or return uses (package deps):
100			@_ ? push(@{$self->{content}->{USE}},@_)
101			: @{$self->{content}->{USE}};
102			}
103			else
104			{
105			my ($name,%attributes)=@_;
106			$self->{DEPENDENCIES}->{$attributes{'name'}} = 1;
107			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{USE}}, $attributes{'name'})
108			: push(@{$self->{content}->{USE}}, $attributes{'name'});
109			}
110			}
111
112			sub architecture()
113			{
114			my ($object,$name,%attributes)=@_;
115			$self->pushlevel(\%attributes); # Set nested to 1;
116			}
117
118			sub architecture_()
119			{
120			$self->{content}->{ARCH}->{$self->{id}->{'name'}}=$self->{tagcontent};
121			$self->poplevel();
122			}
123
124			sub export()
125			{
126			$self->pushlevel(); # Set nested to 1;
127			}
128
129			sub export_()
130			{
131			$self->{content}->{EXPORT} = $self->{tagcontent};
132			$self->poplevel();
133			}
134
135			sub lib()
136			{
137			my ($object,$name,%attributes)=@_;
138			# The getter part:
139			if (ref($object) eq __PACKAGE__)
140			{
141			# Return an array of required libs:
142			return $self->{content}->{LIB};
143			}
144
145			my $libname;
146
147			if (exists($attributes{'position'}))
148			{
149			if ($attributes{'position'} eq 'first')
150			{
151			$libname = "F:".$attributes{'name'};
152			}
153			else
154			{
155			# There was a position entry but it didn't make sense:
156			$libname = $attributes{'name'};
157			}
158			}
159			else
160			{
161			$libname = $attributes{'name'};
162			}
163			# We have a libname, add it to the list:
164			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIB}}, $libname)
165			: push(@{$self->{content}->{LIB}}, $libname);
166			}
167
168			sub libtype()
169			{
170			my ($object,$name,%attributes)=@_;
171			# The getter part:
172			if (ref($object) eq __PACKAGE__)
173			{
174			# Return an array of required libs:
175			return $self->{content}->{LIBTYPE};
176			}
177
178			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{LIBTYPE}}, $attributes{'type'})
179			: push(@{$self->{content}->{LIBTYPE}}, $attributes{'type'});
180			}
181
182			sub skip()
183			{
184			my ($object,$name,%attributes)=@_;
185			$self->{nested} == 1 ? $self->{tagcontent}->{SKIPPEDDIRS} = [ 1 ]
186			: $self->{content}->{SKIPPEDDIRS} = [ 1 ];
187			}
188
189			sub skip_message()
190			{
191			my ($object,$name,@message) = @_;
192			# Save any message text between <skip> tags:
193			if ($#message > -1)
194			{
195			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{SKIPPEDDIRS}}, [ @message ])
196			: push(@{$self->{content}->{SKIPPEDDIRS}}, [ @message ]);
197			}
198			}
199
200			sub skip_()
201			{
202			my ($object,$name)=@_;
203			}
204
205			sub makefile()
206			{
207			my ($object,$name,%attributes)=@_;
208			# The getter part:
209			if (ref($object) eq __PACKAGE__)
210			{
211			# Return Makefile content:
212			return $self->{content}->{MAKEFILE};
213			}
214
215			# Set our own Char handler so we can collect the content
216			# of the Makefile tag:
217			$object->setHandlers(Char => \&makefile_content);
218			$self->{makefilecontent} = [];
219			}
220
221			sub makefile_content()
222			{
223			my ($object, @strings) = @_;
224			push(@{$self->{makefilecontent}},@strings);
225			}
226
227			sub makefile_()
228			{
229			my ($object,$name)=@_;
230			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{MAKEFILE}}, join('',@{$self->{makefilecontent}}))
231			: push(@{$self->{content}->{MAKEFILE}}, join('',@{$self->{makefilecontent}}));
232			delete $self->{makefilecontent};
233			# Unset the Char handler to revert to the default behaviour:
234			$object->setHandlers(Char => 0);
235			}
236
237			sub define_group()
238			{
239			my ($object,$name,%attributes)=@_;
240			$self->pushlevel(\%attributes); # Set nested to 1;
241			}
242
243			sub define_group_()
244			{
245			$self->{content}->{DEFINED_GROUP}->{$self->{id}->{'name'}}=$self->{tagcontent};
246			$self->poplevel();
247			}
248
249			sub group()
250			{
251			my $object=shift;
252			# The getter part:
253			if (ref($object) eq __PACKAGE__)
254			{
255			# Add or return groups:
256			@_ ? push(@{$self->{content}->{GROUP}},@_)
257			: @{$self->{content}->{GROUP}};
258			}
259			else
260			{
261			my ($name,%attributes)=@_;
262			$self->{nested} == 1 ? push(@{$self->{tagcontent}->{GROUP}}, $attributes{'name'})
263			: push(@{$self->{content}->{GROUP}}, $attributes{'name'});
264			}
265			}
266
267			sub flags()
268			{
269			my ($object,$name,%attributes)=@_;
270			# The getter part:
271			if (ref($object) eq __PACKAGE__)
272			{
273			# Return an array of ProductStore hashes:
274			return $self->{content}->{FLAGS};
275			}
276
277			# Extract the flag name and its value:
278			my ($flagname,$flagvaluestring) = each %attributes;
279			$flagname =~ tr/[a-z]/[A-Z]/; # Keep flag name uppercase
280			chomp($flagvaluestring);
281			# Split the value on whitespace so we can push all
282			# individual flags into an array:
283			my @flagvalues = split(' ',$flagvaluestring);
284			# Is current tag within another tag block?
285			if ($self->{nested} == 1)
286			{
287			# Check to see if the current flag name is already stored in the hash. If so,
288			# just add the new values to the array of flag values:
289			if (exists ($self->{tagcontent}->{FLAGS}->{$flagname}))
290			{
291			push(@{$self->{tagcontent}->{FLAGS}->{$flagname}},@flagvalues);
292			}
293			else
294			{
295			$self->{tagcontent}->{FLAGS}->{$flagname} = [ @flagvalues ];
296			}
297			}
298			else
299			{
300			if (exists ($self->{content}->{FLAGS}->{$flagname}))
301			{
302			push(@{$self->{content}->{FLAGS}->{$flagname}},@flagvalues);
303			}
304			else
305			{
306			$self->{content}->{FLAGS}->{$flagname} = [ @flagvalues ];
307			}
308			}
309			}
310	sashby	1.26
311	sashby	1.30	sub allflags()
312			{
313			my $self=shift;
314			# Return hash data for flags:
315			return $self->{content}->{FLAGS};
316	sashby	1.19	}
317	williamc	1.2
318	sashby	1.30	sub archspecific()
319	sashby	1.17	{
320			my $self=shift;
321	sashby	1.30
322			# Check to see if there is arch-dependent data. If so, return it:
323			if ((my $nkeys=keys %{$self->{content}->{ARCH}}) > 0)
324			{
325			while (my ($k,$v) = each %{$self->{content}->{ARCH}})
326			{
327			if ( $ENV{SCRAM_ARCH} =~ /$k.*/ )
328			{
329			return $self->{content}->{ARCH}->{$k};
330			}
331			}
332			}
333			return "";
334			}
335
336			sub bin()
337			{
338			my ($object,$name,%attributes) = @_;
339			$self->pushlevel(\%attributes);# Set nested to 1;
340			}
341
342			sub bin_()
343			{
344			# Need unique name for the binary (always use name of product). Either use "name"
345			# given, or use "file" value minus the ending:
346			if (exists ($self->{id}->{'name'}))
347			{
348			$name = $self->{id}->{'name'};
349			}
350			else
351			{
352			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
353			}
354	sashby	1.26
355	sashby	1.30	# Store the data:
356			$self->productcollector($name,'bin','BIN');
357			$self->poplevel();
358			}
359
360			sub module()
361			{
362			my ($object,$name,%attributes) = @_;
363			$self->pushlevel(\%attributes);# Set nested to 1;
364			}
365
366			sub module_()
367			{
368			# Need unique name for the module (always use name of product). Either use "name"
369			# given, or use "file" value minus the ending:
370			if (exists ($self->{id}->{'name'}))
371			{
372			$name = $self->{id}->{'name'};
373			}
374			else
375			{
376			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
377			}
378
379			# Store the data:
380			$self->productcollector($name,'mod','MODULE');
381			$self->poplevel();
382			}
383
384			sub application()
385			{
386			my ($object,$name,%attributes) = @_;
387			$self->pushlevel(\%attributes);# Set nested to 1;
388			}
389
390			sub application_()
391			{
392			# Need unique name for the application (always use name of product). Either use "name"
393			# given, or use "file" value minus the ending:
394			if (exists ($self->{id}->{'name'}))
395			{
396			$name = $self->{id}->{'name'};
397			}
398			else
399			{
400			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
401			}
402
403			# Store the data:
404			$self->productcollector($name,'app','APPLICATION');
405			$self->poplevel();
406			}
407
408			sub library()
409			{
410			my ($object,$name,%attributes) = @_;
411			$self->pushlevel(\%attributes);# Set nested to 1;
412			}
413
414			sub library_()
415			{
416			# Need unique name for the library (always use name of product). Either use "name"
417			# given, or use "file" value minus the ending:
418			if (exists ($self->{id}->{'name'}))
419			{
420			$name = $self->{id}->{'name'};
421			}
422			else
423			{
424			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
425			}
426
427			# Store the data:
428			$self->productcollector($name,'lib','LIBRARY');
429			$self->poplevel();
430			}
431
432			sub plugin()
433			{
434			my ($object,$name,%attributes) = @_;
435			$self->pushlevel(\%attributes);# Set nested to 1;
436			}
437
438			sub plugin_()
439			{
440			# Need unique name for the plugin (always use name of product). Either use "name"
441			# given, or use "file" value minus the ending:
442			if (exists ($self->{id}->{'name'}))
443			{
444			$name = $self->{id}->{'name'};
445			}
446			else
447			{
448			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
449			}
450
451			# Store the data:
452			$self->productcollector($name,'plugin','PLUGIN');
453			$self->poplevel();
454			}
455
456			sub unittest()
457			{
458			my ($object,$name,%attributes) = @_;
459			$self->pushlevel(\%attributes);# Set nested to 1;
460			}
461
462			sub unittest_()
463			{
464			# Need unique name for the unittest (always use name of product). Either use "name"
465			# given, or use "file" value minus the ending:
466			if (exists ($self->{id}->{'name'}))
467			{
468			$name = $self->{id}->{'name'};
469			}
470			else
471			{
472			($name) = ($self->{id}->{'file'} =~ /(.)?\..$/);
473			}
474
475			# Store the data:
476			$self->productcollector($name,'unittest','unittest');
477			$self->poplevel();
478	sashby	1.15	}
479	williamc	1.1
480	sashby	1.26	sub productcollector()
481	sashby	1.23	{
482			my $self=shift;
483	sashby	1.26	my ($name,$typeshort,$typefull)=@_;
484			# Create a new Product object for storage of data:
485			use BuildSystem::Product;
486			my $product = BuildSystem::Product->new();
487			# Store the name:
488			$product->name($name);
489			$product->type($typeshort);
490	sashby	1.30	# Store the files. Take the BuildFile path as the initial path for
491			# expanding source file globs:
492			$product->_files($self->{id}->{'file'},[ $self->{scramdoc}->filetoparse() ]);
493	sashby	1.26	# Store the data content:
494			$product->_data($self->{tagcontent});
495			# And store in a hash (all build products in same place):
496			$self->{content}->{BUILDPRODUCTS}->{$typefull}->{$name} = $product;
497	sashby	1.23	}
498	williamc	1.1
499	sashby	1.26	sub pushlevel
500	sashby	1.17	{
501	sashby	1.26	my $self = shift;
502			my ($info)=@_;
503	sashby	1.17
504	sashby	1.26	$self->{id} = $info if (defined $info);
505			$self->{nested} = 1;
506			$self->{tagcontent}={};
507			}
508	sashby	1.15
509	sashby	1.26	sub poplevel
510			{
511			my $self = shift;
512			delete $self->{id};
513			delete $self->{nested};
514			delete $self->{tagcontent};
515	sashby	1.17	}
516	williamc	1.2
517	sashby	1.26	sub dependencies()
518	sashby	1.19	{
519			my $self=shift;
520	sashby	1.26	# Make a copy of the variable so that
521			# we don't have a DEPENDENCIES entry in RAWDATA:
522			my %DEPS=%{$self->{DEPENDENCIES}};
523			delete $self->{DEPENDENCIES};
524			return \%DEPS;
525	sashby	1.19	}
526
527	sashby	1.28	sub skippeddirs()
528			{
529			my $self=shift;
530			my ($here)=@_;
531			my $skipped;
532
533			if ($self->{content}->{SKIPPEDDIRS}->[0] == 1)
534			{
535			$skipped = [ @{$self->{content}->{SKIPPEDDIRS}} ];
536			delete $self->{content}->{SKIPPEDDIRS};
537			}
538
539			delete $self->{content}->{SKIPPEDDIRS};
540			return $skipped;
541			}
542
543	sashby	1.30	sub hasexport()
544			{
545			my $self=shift;
546			# Check to see if there is a valid export block:
547			my $nkeys = $self->exporteddatatypes();
548			$nkeys > 0 ? return 1 : return 0;
549			}
550
551			sub has()
552			{
553			my $self=shift;
554			my ($datatype)=@_;
555			(exists ($self->{content}->{$datatype})) ? return 1 : return 0;
556			}
557
558			sub exported()
559			{
560			my $self=shift;
561			# Return a hash. Keys are type of data provided:
562			return ($self->{content}->{EXPORT});
563			}
564
565			sub exporteddatatypes()
566			{
567			my $self=shift;
568			# Return exported data types:
569			return keys %{$self->{content}->{EXPORT}};
570			}
571
572			sub defined_group()
573			{
574			my $self=shift;
575
576			if (exists($self->{content}->{DEFINED_GROUP}))
577			{
578			# Return a list of keys (group names) for defined groups:
579			return [ keys %{$self->{content}->{DEFINED_GROUP}} ];
580			}
581			else
582			{
583			return 0;
584			}
585			}
586
587			sub dataforgroup()
588			{
589			my $self=shift;
590			my ($groupname)=@_;
591			# Return hash containing data for defined group
592			# $groupname or return undef:
593			return $self->{content}->{DEFINED_GROUP}->{$groupname};
594			}
595
596			sub buildproducts()
597			{
598			my $self=shift;
599			# Returns hash of build products and their data:
600			return $self->{content}->{BUILDPRODUCTS};
601			}
602
603			sub values()
604			{
605			my $self=shift;
606			my ($type)=@_;
607			# Get a list of values from known types
608			return $self->{content}->{BUILDPRODUCTS}->{$type};
609			}
610
611			sub basic_tags()
612			{
613			my $self=shift;
614			my $datatags=[];
615			my $buildtags=[ qw(BIN LIBRARY APPLICATION MODULE PLUGIN BUILDPRODUCTS) ];
616			my $skiptags=[ qw(DEFINED_GROUP ARCH EXPORT GROUP USE CLASSPATH) ];
617			my $otherskiptags=[ qw( SKIPPEDDIRS ) ];
618			my @all_skip_tags;
619
620			push(@all_skip_tags,@$skiptags,@$buildtags,@$otherskiptags);
621
622			foreach my $t (keys %{$self->{content}})
623			{
624			push(@$datatags,$t),if (! grep($t eq $_, @all_skip_tags));
625			}
626			return @{$datatags};
627			}
628
629			sub clean()
630			{
631			my $self=shift;
632			my (@tags) = @_;
633
634			# Delete some useless entries:
635			delete $self->{makefilecontent};
636			delete $self->{simpledoc};
637			delete $self->{id};
638			delete $self->{tagcontent};
639			delete $self->{nested};
640
641			delete $self->{DEPENDENCIES};
642
643			map
644			{
645			delete $self->{content}->{$_} if (exists($self->{content}->{$_}));
646			} @tags;
647
648			return $self;
649			}
650
651			sub AUTOLOAD()
652			{
653			my ($xmlparser,$name,%attributes)=@_;
654			return if $AUTOLOAD =~ /::DESTROY$/;
655			my $name=$AUTOLOAD;
656			$name =~ s/.*://;
657			}
658
659	sashby	1.26	1;