src/BuildSystem/ToolData.pm

#____________________________________________________________________ 
# File: ToolData.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2003-11-21 15:26:07+0100
# Revision: $Id: ToolData.pm,v 1.4 2005/04/13 16:45:36 sashby Exp $ 
#
# Copyright: 2003 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::ToolData;
require 5.004;

use Exporter;

@ISA=qw(Exporter);
#
sub new
  ###############################################################
  # new                                                         #
  ###############################################################
  # modified : Fri Nov 21 15:26:14 2003 / SFA                   #
  # params   :                                                  #
  #          :                                                  #
  # function :                                                  #
  #          :                                                  #
  ###############################################################
  {
  my $proto=shift;
  my $class=ref($proto) || $proto;
  my $self={SCRAM_PROJECT => 0};
  bless $self,$class;
  return $self;
  }

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

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

sub lib()
   {
   my $self=shift;
   # Add libs to array:
   @_ ? push(@{$self->{LIB}},@{$_[0]})
      : @{$self->{LIB}};
   }

sub include()
   {
   my $self=shift;
   # Add libs to array:
   @_ ? push(@{$self->{INCLUDE}},@{$_[0]})
      : @{$self->{INCLUDE}};
   }

sub libdir()
   {
   my $self=shift;
   # Add libdir to array:
   @_ ? push(@{$self->{LIBDIR}},@{$_[0]})
      : @{$self->{LIBDIR}};
   }

sub use()
   {
   my $self=shift;
   # Add deps to array:
   @_ ? push(@{$self->{USE}},@{$_[0]})
      : @{$self->{USE}};
   }

sub makefile()
   {
   my $self=shift;
   @_ ? push(@{$self->{MAKEFILE}},@{$_[0]})
      : @{$self->{MAKEFILE}};
   }

sub flags()
   {
   my $self=shift;
   my ($flag,$flagvalue) = @_;

   if ($flag && $flagvalue)
      {
      if (exists ($self->{FLAGS}->{$flag}))
         {
         # Add each flag ONLY if it doesn't already exist:
         foreach my $F (@$flagvalue)
            {
            push(@{$self->{FLAGS}->{$flag}},$F),
            if (! grep($F eq $_,@{$self->{FLAGS}->{$flag}}));
            }
         }
      else
         {
         $self->{FLAGS}->{$flag} = [ @$flagvalue ];
         }
      }
   elsif ($flag && $self->{FLAGS}->{$flag}->[0] ne '')
      {
      return @{$self->{FLAGS}->{$flag}};
      }
   else
      {
      return "";
      }
   }

sub updateflags()
   {
   my $self=shift;
   my ($flag,$flagvalue) = @_;
   # Reset:
   if (exists $self->{FLAGS}->{$flag})
      {
      delete $self->{FLAGS}->{$flag};
      }
   # Reinsert:
   $self->flags($flag,$flagvalue);
   }

sub allflags()
   {
   my $self=shift;
   (scalar(keys %{$self->{FLAGS}}) > 0) ? return $self->{FLAGS} : return undef;
   }

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

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

sub variable_data()
   {
   my $self=shift;
   my ($varname,$varvalue) = @_;
   
   if ($varname && $varvalue)
      {
      $self->{$varname} = $varvalue; # Maybe need to handle more than one value?
      # Keep track of all variables:
      if (! grep($varname eq $_, @{$self->{VARIABLES}}))# Remove duplicates!!
         {
         push(@{$self->{VARIABLES}},$varname);      
         }
      }
   else
      {
      return $self->{$varname};
      }
   }

sub list_variables
   {
   my $self=shift;
   return @{$self->{VARIABLES}};
   }

sub runtime()
   {
   my $self=shift;
   my ($rt,$rtvalue) = @_;

   # If both a runtime name and value are supplied, store this variable:
   if ($rt && $rtvalue)
      {
      # Check to see if the environment already exists:
      if (exists ($self->{RUNTIME}->{$rt}))
         {
         push(@{$self->{RUNTIME}->{$rt}},@$rtvalue);
         }
      else
         {
         # Doesn't already exist so just set the value, in an array:
         $self->{RUNTIME}->{$rt} = [ @$rtvalue ];
         }
      }
   elsif ($rt)
      {
      # Return the value for this runtime var name:
      return $self->{RUNTIME}->{$rt};
      }
   else
      {
      # Return all RT settings:
      return $self->{RUNTIME};
      }
   }

sub getfeatures()
   {
   my $self=shift;
   my ($feature)=@_;
   my @feature_vars=$self->list_variables();
   my @features;
   push (@features, @feature_vars, qw(LIB LIBDIR INCLUDE MAKEFILE USE));

   # Make sure feature name is uppercase:
   $feature =~ tr/a-z/A-Z/;
   if ($feature) # A feature name was given
      {
      # Check to see if this feature is valid and is defined for this tool:
      if (grep($feature eq $_, @features) && exists($self->{$feature}))
         {
         (ref($self->{$feature}) eq 'ARRAY') ? print join(" ",@{$self->{$feature}})
            : print join(" ",$self->{$feature});
         print "\n";
         }
      else
         {
         # This feature isn't a valid feature or is valid but doens't
         # have a value for this tool:
         print "SCRAM: No type of variable called \"",$feature,"\" ","defined for this tool.\n";
         }
      }
   else
      {
      # No feature name so dump list of valid features for current tool:
      map
         {
         print $_,"\n", if (exists ($self->{$_}));
         } @features;
      }
   }

sub summarize_features()
   {
   my $self=shift;
   my @variables = $self->list_variables();

   # Show whether this tool is a SCRAM project or not:
   print "SCRAM_PROJECT=";
   ($self->scram_project() == 1) ? print "yes" : print "no";
   print "\n";

   # A compiler tool?
   if ($self->scram_compiler() == 1)
      {
      print "SCRAM_COMPILER=yes\n";
      }

   # Print out any variables:
   foreach my $var (@variables)
      {
      print $var,"=",$self->{$var},"\n";
      }

   # Makefile and flags first:
   if (exists($self->{'MAKEFILE'}) && $#{$self->{'MAKEFILE'}} != -1)
      {
      print join(" ",@{$self->{'MAKEFILE'}}),"\n\n";
      }

   if (exists($self->{'FLAGS'}) && (my ($nkeys) = scalar(keys %{$self->{'FLAGS'}}) > 0 ))
      {
      my $flags=$self->allflags();
      
      while (my ($f,$fv) = each %{$flags})
         {
         print $f,"+=",join(" ",@{$fv}),"\n";
         }      
      }

   foreach my $feature (qw( LIB LIBDIR INCLUDE USE ))
      {
      if (exists($self->{$feature}) && $#{$self->{$feature}} != -1)
         {
         print $feature,"=",join(" ",@{$self->{$feature}}),"\n";
         }
      }

   # Finally, look for runtime vars:
   if (exists($self->{'RUNTIME'}) && (my ($nkeys) = scalar(keys %{$self->{'RUNTIME'}}) > 0 ))
      {
      while (my ($rt,$val) = each %{$self->{'RUNTIME'}})
         {
         if ($rt =~ /:/)
            {
            my ($type,$name) = split(":",$rt);
            print $name,"=",join(":",@$val),"\n";
            }
         else
            {
            print $rt,"=",join(":",@$val),"\n";
            }
         }
      }
   
   print "\n";
   }

   
sub addreleasetoself()
   {
   my $self=shift;
   # Go through the settings obtained so far (only from SELF) and, for
   # every LIBDIR/INCLUDE/RUNTIME path, add another value with
   # LOCALTOP==RELEASETOP:
   my $relldir = [];
   my $relinc = [];
   my @locallibdirs = $self->libdir();
   my @localincdirs = $self->include();
   
   foreach my $libdir (@locallibdirs)
      {
      # Convert LOCAL to RELEASE top:
      $libdir =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
      push(@$relldir, $libdir);
      }
   
   # Add the new libdirs to our object:
   $self->libdir($relldir);
   
   foreach my $incdir (@localincdirs)
      {
      # Convert LOCAL to RELEASE top:
      $incdir =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
      push(@$relinc, $incdir);
      }
   
   # Add the new libdirs to our object:
   $self->include($relinc);

   # Handle runtime settings:
   my $runtime=$self->runtime();
   
   while (my ($rt,$val) = each %{$runtime})
      {
      # Only handle anything that's a PATH:
      if ($rt =~ /:/)
         {
         my ($type,$name) = split(":",$rt);
         
         if ($type eq 'PATH')
            {
            my @PATHS=@$val;
            my $RELPATHS=[];
            
            # Process the values for this path:
            foreach my $rtpath (@PATHS)
               {
               $rtpath =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
               push(@$RELPATHS,$rtpath);
               }
            
            # Add the new settings:
            $self->runtime($rt,$RELPATHS);
            }
         }
      }
   
   }

1;
Revision:	1.5
Committed:	Fri Jul 15 15:27:27 2005 UTC (19 years, 9 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.4:	+14 -1 lines
Log Message:	First fully-working version.
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: ToolData.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2003-11-21 15:26:07+0100
7	sashby	1.5	# Revision: $Id: ToolData.pm,v 1.4 2005/04/13 16:45:36 sashby Exp $
8	sashby	1.2	#
9			# Copyright: 2003 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::ToolData;
13			require 5.004;
14
15			use Exporter;
16
17			@ISA=qw(Exporter);
18			#
19			sub new
20			###############################################################
21			# new #
22			###############################################################
23			# modified : Fri Nov 21 15:26:14 2003 / SFA #
24			# params : #
25			# : #
26			# function : #
27			# : #
28			###############################################################
29			{
30			my $proto=shift;
31			my $class=ref($proto) \|\| $proto;
32			my $self={SCRAM_PROJECT => 0};
33			bless $self,$class;
34			return $self;
35			}
36
37			sub toolname()
38			{
39			my $self=shift;
40			@_ ? $self->{TOOLNAME} = shift
41			: $self->{TOOLNAME};
42			}
43
44			sub toolversion()
45			{
46			my $self=shift;
47			@_ ? $self->{TOOLVERSION} = shift
48			: $self->{TOOLVERSION};
49			}
50
51			sub lib()
52			{
53			my $self=shift;
54			# Add libs to array:
55			@_ ? push(@{$self->{LIB}},@{$_[0]})
56			: @{$self->{LIB}};
57			}
58
59			sub include()
60			{
61			my $self=shift;
62			# Add libs to array:
63			@_ ? push(@{$self->{INCLUDE}},@{$_[0]})
64			: @{$self->{INCLUDE}};
65			}
66
67			sub libdir()
68			{
69			my $self=shift;
70			# Add libdir to array:
71			@_ ? push(@{$self->{LIBDIR}},@{$_[0]})
72			: @{$self->{LIBDIR}};
73			}
74
75			sub use()
76			{
77			my $self=shift;
78			# Add deps to array:
79			@_ ? push(@{$self->{USE}},@{$_[0]})
80			: @{$self->{USE}};
81			}
82
83			sub makefile()
84			{
85			my $self=shift;
86			@_ ? push(@{$self->{MAKEFILE}},@{$_[0]})
87			: @{$self->{MAKEFILE}};
88			}
89
90			sub flags()
91			{
92			my $self=shift;
93			my ($flag,$flagvalue) = @_;
94
95			if ($flag && $flagvalue)
96			{
97			if (exists ($self->{FLAGS}->{$flag}))
98			{
99			# Add each flag ONLY if it doesn't already exist:
100			foreach my $F (@$flagvalue)
101			{
102			push(@{$self->{FLAGS}->{$flag}},$F),
103			if (! grep($F eq $_,@{$self->{FLAGS}->{$flag}}));
104			}
105			}
106			else
107			{
108			$self->{FLAGS}->{$flag} = [ @$flagvalue ];
109			}
110			}
111			elsif ($flag && $self->{FLAGS}->{$flag}->[0] ne '')
112			{
113			return @{$self->{FLAGS}->{$flag}};
114			}
115			else
116			{
117			return "";
118			}
119			}
120
121	sashby	1.5	sub updateflags()
122			{
123			my $self=shift;
124			my ($flag,$flagvalue) = @_;
125			# Reset:
126			if (exists $self->{FLAGS}->{$flag})
127			{
128			delete $self->{FLAGS}->{$flag};
129			}
130			# Reinsert:
131			$self->flags($flag,$flagvalue);
132			}
133
134	sashby	1.2	sub allflags()
135			{
136			my $self=shift;
137			(scalar(keys %{$self->{FLAGS}}) > 0) ? return $self->{FLAGS} : return undef;
138			}
139
140			sub scram_project()
141			{
142			my $self=shift;
143			@_ ? $self->{SCRAM_PROJECT} = shift
144			: $self->{SCRAM_PROJECT};
145			}
146
147	sashby	1.4	sub scram_compiler()
148			{
149			my $self=shift;
150			@_ ? $self->{SCRAM_COMPILER} = shift
151			: $self->{SCRAM_COMPILER};
152			}
153
154	sashby	1.2	sub variable_data()
155			{
156			my $self=shift;
157			my ($varname,$varvalue) = @_;
158
159			if ($varname && $varvalue)
160			{
161			$self->{$varname} = $varvalue; # Maybe need to handle more than one value?
162			# Keep track of all variables:
163			if (! grep($varname eq $_, @{$self->{VARIABLES}}))# Remove duplicates!!
164			{
165			push(@{$self->{VARIABLES}},$varname);
166			}
167			}
168			else
169			{
170			return $self->{$varname};
171			}
172			}
173
174			sub list_variables
175			{
176			my $self=shift;
177			return @{$self->{VARIABLES}};
178			}
179
180			sub runtime()
181			{
182			my $self=shift;
183			my ($rt,$rtvalue) = @_;
184
185			# If both a runtime name and value are supplied, store this variable:
186			if ($rt && $rtvalue)
187			{
188			# Check to see if the environment already exists:
189			if (exists ($self->{RUNTIME}->{$rt}))
190			{
191			push(@{$self->{RUNTIME}->{$rt}},@$rtvalue);
192			}
193			else
194			{
195			# Doesn't already exist so just set the value, in an array:
196			$self->{RUNTIME}->{$rt} = [ @$rtvalue ];
197			}
198			}
199			elsif ($rt)
200			{
201			# Return the value for this runtime var name:
202			return $self->{RUNTIME}->{$rt};
203			}
204			else
205			{
206			# Return all RT settings:
207			return $self->{RUNTIME};
208			}
209			}
210
211			sub getfeatures()
212			{
213			my $self=shift;
214			my ($feature)=@_;
215			my @feature_vars=$self->list_variables();
216			my @features;
217			push (@features, @feature_vars, qw(LIB LIBDIR INCLUDE MAKEFILE USE));
218
219			# Make sure feature name is uppercase:
220			$feature =~ tr/a-z/A-Z/;
221			if ($feature) # A feature name was given
222			{
223			# Check to see if this feature is valid and is defined for this tool:
224			if (grep($feature eq $_, @features) && exists($self->{$feature}))
225			{
226			(ref($self->{$feature}) eq 'ARRAY') ? print join(" ",@{$self->{$feature}})
227			: print join(" ",$self->{$feature});
228			print "\n";
229			}
230			else
231			{
232			# This feature isn't a valid feature or is valid but doens't
233			# have a value for this tool:
234			print "SCRAM: No type of variable called \"",$feature,"\" ","defined for this tool.\n";
235			}
236			}
237			else
238			{
239			# No feature name so dump list of valid features for current tool:
240			map
241			{
242			print $_,"\n", if (exists ($self->{$_}));
243			} @features;
244			}
245			}
246
247			sub summarize_features()
248			{
249			my $self=shift;
250			my @variables = $self->list_variables();
251
252			# Show whether this tool is a SCRAM project or not:
253			print "SCRAM_PROJECT=";
254			($self->scram_project() == 1) ? print "yes" : print "no";
255			print "\n";
256
257	sashby	1.4	# A compiler tool?
258			if ($self->scram_compiler() == 1)
259			{
260			print "SCRAM_COMPILER=yes\n";
261			}
262
263	sashby	1.2	# Print out any variables:
264			foreach my $var (@variables)
265			{
266			print $var,"=",$self->{$var},"\n";
267			}
268
269			# Makefile and flags first:
270			if (exists($self->{'MAKEFILE'}) && $#{$self->{'MAKEFILE'}} != -1)
271			{
272			print join(" ",@{$self->{'MAKEFILE'}}),"\n\n";
273			}
274
275			if (exists($self->{'FLAGS'}) && (my ($nkeys) = scalar(keys %{$self->{'FLAGS'}}) > 0 ))
276			{
277			my $flags=$self->allflags();
278
279			while (my ($f,$fv) = each %{$flags})
280			{
281			print $f,"+=",join(" ",@{$fv}),"\n";
282			}
283			}
284
285			foreach my $feature (qw( LIB LIBDIR INCLUDE USE ))
286			{
287			if (exists($self->{$feature}) && $#{$self->{$feature}} != -1)
288			{
289			print $feature,"=",join(" ",@{$self->{$feature}}),"\n";
290			}
291			}
292
293			# Finally, look for runtime vars:
294			if (exists($self->{'RUNTIME'}) && (my ($nkeys) = scalar(keys %{$self->{'RUNTIME'}}) > 0 ))
295			{
296	sashby	1.3	while (my ($rt,$val) = each %{$self->{'RUNTIME'}})
297	sashby	1.2	{
298			if ($rt =~ /:/)
299			{
300			my ($type,$name) = split(":",$rt);
301			print $name,"=",join(":",@$val),"\n";
302			}
303			else
304			{
305			print $rt,"=",join(":",@$val),"\n";
306			}
307			}
308			}
309
310			print "\n";
311			}
312
313
314			sub addreleasetoself()
315			{
316			my $self=shift;
317			# Go through the settings obtained so far (only from SELF) and, for
318			# every LIBDIR/INCLUDE/RUNTIME path, add another value with
319			# LOCALTOP==RELEASETOP:
320			my $relldir = [];
321			my $relinc = [];
322			my @locallibdirs = $self->libdir();
323			my @localincdirs = $self->include();
324
325			foreach my $libdir (@locallibdirs)
326			{
327			# Convert LOCAL to RELEASE top:
328			$libdir =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
329			push(@$relldir, $libdir);
330			}
331
332			# Add the new libdirs to our object:
333			$self->libdir($relldir);
334
335			foreach my $incdir (@localincdirs)
336			{
337			# Convert LOCAL to RELEASE top:
338			$incdir =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
339			push(@$relinc, $incdir);
340			}
341
342			# Add the new libdirs to our object:
343			$self->include($relinc);
344
345			# Handle runtime settings:
346			my $runtime=$self->runtime();
347
348			while (my ($rt,$val) = each %{$runtime})
349			{
350			# Only handle anything that's a PATH:
351			if ($rt =~ /:/)
352			{
353			my ($type,$name) = split(":",$rt);
354
355			if ($type eq 'PATH')
356			{
357			my @PATHS=@$val;
358			my $RELPATHS=[];
359
360			# Process the values for this path:
361			foreach my $rtpath (@PATHS)
362			{
363			$rtpath =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
364			push(@$RELPATHS,$rtpath);
365			}
366
367			# Add the new settings:
368			$self->runtime($rt,$RELPATHS);
369			}
370			}
371			}
372
373			}
374
375			1;