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.5 2007/11/08 15:25:27 muzaffar 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)=@_;
   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 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) = @_;
   foreach my $str (@strings)
      {
      push(@{$self->{makefilecontent}},$str);
      }
   }

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