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
#	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	muzaffar	1.32	# Revision: $Id: BuildFile.pm,v 1.29.4.5 2007/11/08 15:25:27 muzaffar 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	muzaffar	1.31	my $fhead='<?xml version="1.0" encoding="UTF-8" standalone="yes"?><doc type="BuildSystem::BuildFile" version="1.0">';
47			my $ftail='</doc>';
48	sashby	1.30	$self->{scramdoc}->filetoparse($filename);
49	muzaffar	1.31	$self->{scramdoc}->parse("builder",$fhead,$ftail);
50	sashby	1.30	# We're done with the SimpleDoc object so delete it:
51			delete $self->{scramdoc};
52			}
53	sashby	1.26
54	sashby	1.30	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	sashby	1.26	}
66	williamc	1.2
67	sashby	1.30	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	sashby	1.19	{
83			my $self=shift;
84	sashby	1.30	# 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	muzaffar	1.31	foreach my $str (@strings)
227			{
228			push(@{$self->{makefilecontent}},$str);
229			}
230	sashby	1.30	}
231
232			sub makefile_()
233			{
234			my ($object,$name)=@_;
235	muzaffar	1.31	$self->{nested} == 1 ? push(@{$self->{tagcontent}->{MAKEFILE}}, join("\n",@{$self->{makefilecontent}}))
236			: push(@{$self->{content}->{MAKEFILE}}, join("\n",@{$self->{makefilecontent}}));
237	sashby	1.30	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	muzaffar	1.31	my @flagvalues = ( $flagvaluestring );
287	sashby	1.30	# 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	sashby	1.26
314	sashby	1.30	sub allflags()
315			{
316			my $self=shift;
317			# Return hash data for flags:
318			return $self->{content}->{FLAGS};
319	sashby	1.19	}
320	williamc	1.2
321	sashby	1.30	sub archspecific()
322	sashby	1.17	{
323			my $self=shift;
324	sashby	1.30
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	sashby	1.26
358	sashby	1.30	# 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	sashby	1.15	}
482	williamc	1.1
483	sashby	1.26	sub productcollector()
484	sashby	1.23	{
485			my $self=shift;
486	sashby	1.26	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	sashby	1.30	# 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	sashby	1.26	# 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	sashby	1.23	}
501	williamc	1.1
502	sashby	1.26	sub pushlevel
503	sashby	1.17	{
504	sashby	1.26	my $self = shift;
505			my ($info)=@_;
506	sashby	1.17
507	sashby	1.26	$self->{id} = $info if (defined $info);
508			$self->{nested} = 1;
509			$self->{tagcontent}={};
510			}
511	sashby	1.15
512	sashby	1.26	sub poplevel
513			{
514			my $self = shift;
515			delete $self->{id};
516			delete $self->{nested};
517			delete $self->{tagcontent};
518	sashby	1.17	}
519	williamc	1.2
520	sashby	1.26	sub dependencies()
521	sashby	1.19	{
522			my $self=shift;
523	sashby	1.26	# 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	sashby	1.19	}
529
530	sashby	1.28	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	sashby	1.30	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	sashby	1.26	1;