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.
#	Content
1	#____________________________________________________________________
2	# File: BuildFile.pm
3	#____________________________________________________________________
4	#
5	# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6	# Update: 2003-12-03 19:03:15+0100
7	# Revision: $Id: BuildFile.pm,v 1.29.4.4 2007/02/27 11:38:39 sashby Exp $
8	#
9	# Copyright: 2003 (C) Shaun Ashby
10	#
11	#--------------------------------------------------------------------
12	package BuildSystem::BuildFile;
13	require 5.004;
14	use Exporter;
15	use ActiveDoc::SimpleDoc;
16
17	@ISA=qw(Exporter);
18	@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	$self={};
34	bless $self,$class;
35	$self->{DEPENDENCIES} = {};
36	$self->{content} = {};
37	$self->{scramdoc}=ActiveDoc::SimpleDoc->new();
38	$self->{scramdoc}->newparse("builder",__PACKAGE__,'Subs');
39	return $self;
40	}
41
42	sub parse()
43	{
44	my $self=shift;
45	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
52	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	}
64
65	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	{
81	my $self=shift;
82	# 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
311	sub allflags()
312	{
313	my $self=shift;
314	# Return hash data for flags:
315	return $self->{content}->{FLAGS};
316	}
317
318	sub archspecific()
319	{
320	my $self=shift;
321
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
355	# 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	}
479
480	sub productcollector()
481	{
482	my $self=shift;
483	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	# 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	# 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	}
498
499	sub pushlevel
500	{
501	my $self = shift;
502	my ($info)=@_;
503
504	$self->{id} = $info if (defined $info);
505	$self->{nested} = 1;
506	$self->{tagcontent}={};
507	}
508
509	sub poplevel
510	{
511	my $self = shift;
512	delete $self->{id};
513	delete $self->{nested};
514	delete $self->{tagcontent};
515	}
516
517	sub dependencies()
518	{
519	my $self=shift;
520	# 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	}
526
527	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	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	1;