src/BuildSystem/Product.pm

#____________________________________________________________________ 
# File: Product.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2004-07-27 11:49:59+0200
# Revision: $Id: Product.pm,v 1.3 2007/02/27 11:59:44 sashby Exp $ 
#
# Copyright: 2004 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::Product;
require 5.004;
use Exporter;
@EXPORT_OK=qw( );

sub new()
  ###############################################################
  # new                                                         #
  ###############################################################
  # modified : Wed Apr 14 12:59:34 2004 / SFA                   #
  # params   :                                                  #
  #          :                                                  #
  # function :                                                  #
  #          :                                                  #
  ###############################################################
  {
  my $proto=shift;
  my $class=ref($proto) || $proto;
  my $self={};
  
  bless $self,$class;
  return $self;
  }

sub name()
   {
   my $self=shift;
   @_ ? $self->{NAME} = shift
      : $self->{NAME};
   }

sub safename()
   {
   my $self=shift;
   $self->{SAFENAME} = $self->{NAME};
   $self->{SAFENAME} =~ s/\./_/g;
   return $self->{SAFENAME};
   }

sub _data()
   {
   # Private data (raw data from BuildFile <prod> tags (bin/lib/mod etc)):
   my $self=shift;
   @_ ? $self->{content} = shift
      : $self->{content};
   }

sub data()
   {
   # Public data (processed data from BuildFile):
   my $self=shift;
   @_ ? $self->{DATA} = shift
      : $self->{DATA};
   }

sub type()
   {
   my $self=shift;
   @_ ? $self->{TYPE} = shift
      : $self->{TYPE};
   }

sub _files()
   {
   my $self=shift;
   my ($rfiles,$pathstotry)=@_;
   my $files=[];

   if ($rfiles)
      {
      # Here, we process the input file "string" and convert it from
      # a comma-sep list/glob to array contents:
      if ($rfiles =~ s/,/ /g)
         {
         push(@$files, split(" ",$rfiles));
         }
      elsif ($rfiles =~ /\*\..*/) # Globs. We use the paths from BuildFiles
         {                        # to figure out where the files are
         use File::Basename;
         # List of paths to try globs from in lib tags:
         my $pathlist=[ map { dirname($_) } @$pathstotry ];
         
         # The most likely location to search for files will be the longest
         # path (up to BuildFile). We apply a reverse sort to get longest
         # path first, then test this against the first element X of $rfiles (match to "X/"):
         foreach my $path (reverse sort @$pathlist)
            {
            if ($rfiles =~ m|(.*?)/\*\..*|)
               {
               # We have a file list like "dir/*.cc"; extract "dir":
               my $subdir=$1;
               if ( -d $path."/".$subdir)
                  {
                  my $filelocation=$path."/".$rfiles;
                  map
                     {
                     # Take the basename of each file but then re-add
                     # the matched subdir above:
                     push(@$files, $subdir."/".basename($_));
                     } glob($filelocation);
                  }
               last;
               }
            else
               {
               # We just glob from the first path:
               my $filelocation=$path."/".$rfiles;
               map
                  {
                  push(@$files, basename($_));
                  } glob($filelocation);
               
               last;
               }
            }
         }
      else
         {
         # Split on whitespace and push onto array:
         push(@$files, split(" ",$rfiles));
         }
      
      $self->{FILES} = $files;
      }
   else
      {
      return $self->{FILES};
      }
   }

sub files()
   {
   my $self=shift;
   return join(" ",@{$self->_files()});
   }

sub lib
   {
   my $self=shift;
   # Return an array of required libs:
   return $self->{content}->{LIB};
   }

sub include
   {
   my $self=shift;
   # Return an array of required includes:
   return $self->{content}->{INCLUDE};
   }

sub libtype
   {
   my $self=shift;
   # Return an array of required lib types:
   return $self->{content}->{LIBTYPE};
   }

sub flags
   {
   my $self=shift;
   # Return hash data for flags:
   return $self->{content}->{FLAGS};
   }

sub allflags
   {
   my $self=shift;
   # Return hash data for flags:
   return $self->{content}->{FLAGS};
   }

sub makefile
   {
   my $self=shift;
   # Return an array of makefile stubs:
   return $self->{content}->{MAKEFILE};
   }

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 use
   {
   my $self=shift;
   # Add or return uses (package deps):
   @_ ? push(@{$self->{content}->{USE}},@_)
      : @{$self->{content}->{USE}};
   }

sub group
   {
   my $self=shift;
   # Add or return groups:
   @_ ? push(@{$self->{content}->{GROUP}},@_)
      : @{$self->{content}->{GROUP}};
   }

sub basic_tags()
   {
   my $self=shift;
   my $datatags=[];
   my $buildtags=[ qw(BIN LIBRARY APPLICATION MODULE PLUGIN UNITTEST 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 AUTOLOAD()
   {
   my ($xmlparser,$name,%attributes)=@_;
   return if $AUTOLOAD =~ /::DESTROY$/;
   my $name=$AUTOLOAD;
   $name =~ s/.*://;
   print __PACKAGE__."::AUTOLOAD: $name() called. This function should be defined.\n";
   }

1;
Revision:	1.4
Committed:	Tue Feb 27 14:45:46 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.3:	+2 -2 lines
Log Message:	removed obsoletes
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: Product.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2004-07-27 11:49:59+0200
7	sashby	1.4	# Revision: $Id: Product.pm,v 1.3 2007/02/27 11:59:44 sashby Exp $
8	sashby	1.2	#
9			# Copyright: 2004 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::Product;
13			require 5.004;
14			use Exporter;
15			@EXPORT_OK=qw( );
16
17			sub new()
18			###############################################################
19			# new #
20			###############################################################
21			# modified : Wed Apr 14 12:59:34 2004 / SFA #
22			# params : #
23			# : #
24			# function : #
25			# : #
26			###############################################################
27			{
28			my $proto=shift;
29			my $class=ref($proto) \|\| $proto;
30			my $self={};
31
32			bless $self,$class;
33			return $self;
34			}
35
36			sub name()
37			{
38			my $self=shift;
39			@_ ? $self->{NAME} = shift
40			: $self->{NAME};
41			}
42
43			sub safename()
44			{
45			my $self=shift;
46			$self->{SAFENAME} = $self->{NAME};
47			$self->{SAFENAME} =~ s/\./_/g;
48			return $self->{SAFENAME};
49			}
50
51			sub _data()
52			{
53			# Private data (raw data from BuildFile <prod> tags (bin/lib/mod etc)):
54			my $self=shift;
55			@_ ? $self->{content} = shift
56			: $self->{content};
57			}
58
59			sub data()
60			{
61			# Public data (processed data from BuildFile):
62			my $self=shift;
63			@_ ? $self->{DATA} = shift
64			: $self->{DATA};
65			}
66
67			sub type()
68			{
69			my $self=shift;
70			@_ ? $self->{TYPE} = shift
71			: $self->{TYPE};
72			}
73
74			sub _files()
75			{
76			my $self=shift;
77			my ($rfiles,$pathstotry)=@_;
78			my $files=[];
79
80			if ($rfiles)
81			{
82			# Here, we process the input file "string" and convert it from
83			# a comma-sep list/glob to array contents:
84			if ($rfiles =~ s/,/ /g)
85			{
86			push(@$files, split(" ",$rfiles));
87			}
88			elsif ($rfiles =~ /\\../) # Globs. We use the paths from BuildFiles
89			{ # to figure out where the files are
90			use File::Basename;
91			# List of paths to try globs from in lib tags:
92			my $pathlist=[ map { dirname($_) } @$pathstotry ];
93
94			# The most likely location to search for files will be the longest
95			# path (up to BuildFile). We apply a reverse sort to get longest
96			# path first, then test this against the first element X of $rfiles (match to "X/"):
97			foreach my $path (reverse sort @$pathlist)
98			{
99			if ($rfiles =~ m\|(.?)/\\..*\|)
100			{
101			# We have a file list like "dir/*.cc"; extract "dir":
102			my $subdir=$1;
103			if ( -d $path."/".$subdir)
104			{
105			my $filelocation=$path."/".$rfiles;
106			map
107			{
108			# Take the basename of each file but then re-add
109			# the matched subdir above:
110			push(@$files, $subdir."/".basename($_));
111			} glob($filelocation);
112			}
113			last;
114			}
115			else
116			{
117			# We just glob from the first path:
118			my $filelocation=$path."/".$rfiles;
119			map
120			{
121			push(@$files, basename($_));
122			} glob($filelocation);
123
124			last;
125			}
126			}
127			}
128			else
129			{
130			# Split on whitespace and push onto array:
131			push(@$files, split(" ",$rfiles));
132			}
133
134			$self->{FILES} = $files;
135			}
136			else
137			{
138			return $self->{FILES};
139			}
140			}
141
142			sub files()
143			{
144			my $self=shift;
145			return join(" ",@{$self->_files()});
146			}
147
148	sashby	1.3	sub lib
149			{
150			my $self=shift;
151			# Return an array of required libs:
152			return $self->{content}->{LIB};
153			}
154
155			sub include
156			{
157			my $self=shift;
158			# Return an array of required includes:
159			return $self->{content}->{INCLUDE};
160			}
161
162			sub libtype
163			{
164			my $self=shift;
165			# Return an array of required lib types:
166			return $self->{content}->{LIBTYPE};
167			}
168
169			sub flags
170			{
171			my $self=shift;
172			# Return hash data for flags:
173			return $self->{content}->{FLAGS};
174			}
175
176			sub allflags
177			{
178			my $self=shift;
179			# Return hash data for flags:
180			return $self->{content}->{FLAGS};
181			}
182
183			sub makefile
184			{
185			my $self=shift;
186			# Return an array of makefile stubs:
187			return $self->{content}->{MAKEFILE};
188			}
189
190			sub archspecific
191			{
192			my $self=shift;
193
194			# Check to see if there is arch-dependent data. If so, return it:
195			if ((my $nkeys=keys %{$self->{content}->{ARCH}}) > 0)
196			{
197			while (my ($k,$v) = each %{$self->{content}->{ARCH}})
198			{
199			if ( $ENV{SCRAM_ARCH} =~ /$k.*/ )
200			{
201			return $self->{content}->{ARCH}->{$k};
202			}
203			}
204			}
205			return "";
206			}
207
208			sub use
209			{
210			my $self=shift;
211			# Add or return uses (package deps):
212			@_ ? push(@{$self->{content}->{USE}},@_)
213			: @{$self->{content}->{USE}};
214			}
215
216			sub group
217			{
218			my $self=shift;
219			# Add or return groups:
220			@_ ? push(@{$self->{content}->{GROUP}},@_)
221			: @{$self->{content}->{GROUP}};
222			}
223
224			sub basic_tags()
225			{
226			my $self=shift;
227			my $datatags=[];
228	sashby	1.4	my $buildtags=[ qw(BIN LIBRARY APPLICATION MODULE PLUGIN UNITTEST BUILDPRODUCTS) ];
229	sashby	1.3	my $skiptags=[ qw(DEFINED_GROUP ARCH EXPORT GROUP USE CLASSPATH) ];
230			my $otherskiptags=[ qw( SKIPPEDDIRS ) ];
231			my @all_skip_tags;
232
233			push(@all_skip_tags,@$skiptags,@$buildtags,@$otherskiptags);
234
235			foreach my $t (keys %{$self->{content}})
236			{
237			push(@$datatags,$t),if (! grep($t eq $_, @all_skip_tags));
238			}
239			return @{$datatags};
240			}
241
242			sub AUTOLOAD()
243			{
244			my ($xmlparser,$name,%attributes)=@_;
245			return if $AUTOLOAD =~ /::DESTROY$/;
246			my $name=$AUTOLOAD;
247			$name =~ s/.*://;
248			print __PACKAGE__."::AUTOLOAD: $name() called. This function should be defined.\n";
249			}
250
251	sashby	1.2	1;