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.3 2005/02/02 16:31:11 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 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.4
Committed:	Wed Apr 13 16:45:36 2005 UTC (20 years ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	v102p1
Changes since 1.3:	+14 -1 lines
Log Message:	Start to add support for user interaction with compiler meta.
#	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.4	# Revision: $Id: ToolData.pm,v 1.3 2005/02/02 16:31:11 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			sub allflags()
122			{
123			my $self=shift;
124			(scalar(keys %{$self->{FLAGS}}) > 0) ? return $self->{FLAGS} : return undef;
125			}
126
127			sub scram_project()
128			{
129			my $self=shift;
130			@_ ? $self->{SCRAM_PROJECT} = shift
131			: $self->{SCRAM_PROJECT};
132			}
133
134	sashby	1.4	sub scram_compiler()
135			{
136			my $self=shift;
137			@_ ? $self->{SCRAM_COMPILER} = shift
138			: $self->{SCRAM_COMPILER};
139			}
140
141	sashby	1.2	sub variable_data()
142			{
143			my $self=shift;
144			my ($varname,$varvalue) = @_;
145
146			if ($varname && $varvalue)
147			{
148			$self->{$varname} = $varvalue; # Maybe need to handle more than one value?
149			# Keep track of all variables:
150			if (! grep($varname eq $_, @{$self->{VARIABLES}}))# Remove duplicates!!
151			{
152			push(@{$self->{VARIABLES}},$varname);
153			}
154			}
155			else
156			{
157			return $self->{$varname};
158			}
159			}
160
161			sub list_variables
162			{
163			my $self=shift;
164			return @{$self->{VARIABLES}};
165			}
166
167			sub runtime()
168			{
169			my $self=shift;
170			my ($rt,$rtvalue) = @_;
171
172			# If both a runtime name and value are supplied, store this variable:
173			if ($rt && $rtvalue)
174			{
175			# Check to see if the environment already exists:
176			if (exists ($self->{RUNTIME}->{$rt}))
177			{
178			push(@{$self->{RUNTIME}->{$rt}},@$rtvalue);
179			}
180			else
181			{
182			# Doesn't already exist so just set the value, in an array:
183			$self->{RUNTIME}->{$rt} = [ @$rtvalue ];
184			}
185			}
186			elsif ($rt)
187			{
188			# Return the value for this runtime var name:
189			return $self->{RUNTIME}->{$rt};
190			}
191			else
192			{
193			# Return all RT settings:
194			return $self->{RUNTIME};
195			}
196			}
197
198			sub getfeatures()
199			{
200			my $self=shift;
201			my ($feature)=@_;
202			my @feature_vars=$self->list_variables();
203			my @features;
204			push (@features, @feature_vars, qw(LIB LIBDIR INCLUDE MAKEFILE USE));
205
206			# Make sure feature name is uppercase:
207			$feature =~ tr/a-z/A-Z/;
208			if ($feature) # A feature name was given
209			{
210			# Check to see if this feature is valid and is defined for this tool:
211			if (grep($feature eq $_, @features) && exists($self->{$feature}))
212			{
213			(ref($self->{$feature}) eq 'ARRAY') ? print join(" ",@{$self->{$feature}})
214			: print join(" ",$self->{$feature});
215			print "\n";
216			}
217			else
218			{
219			# This feature isn't a valid feature or is valid but doens't
220			# have a value for this tool:
221			print "SCRAM: No type of variable called \"",$feature,"\" ","defined for this tool.\n";
222			}
223			}
224			else
225			{
226			# No feature name so dump list of valid features for current tool:
227			map
228			{
229			print $_,"\n", if (exists ($self->{$_}));
230			} @features;
231			}
232			}
233
234			sub summarize_features()
235			{
236			my $self=shift;
237			my @variables = $self->list_variables();
238
239			# Show whether this tool is a SCRAM project or not:
240			print "SCRAM_PROJECT=";
241			($self->scram_project() == 1) ? print "yes" : print "no";
242			print "\n";
243
244	sashby	1.4	# A compiler tool?
245			if ($self->scram_compiler() == 1)
246			{
247			print "SCRAM_COMPILER=yes\n";
248			}
249
250	sashby	1.2	# Print out any variables:
251			foreach my $var (@variables)
252			{
253			print $var,"=",$self->{$var},"\n";
254			}
255
256			# Makefile and flags first:
257			if (exists($self->{'MAKEFILE'}) && $#{$self->{'MAKEFILE'}} != -1)
258			{
259			print join(" ",@{$self->{'MAKEFILE'}}),"\n\n";
260			}
261
262			if (exists($self->{'FLAGS'}) && (my ($nkeys) = scalar(keys %{$self->{'FLAGS'}}) > 0 ))
263			{
264			my $flags=$self->allflags();
265
266			while (my ($f,$fv) = each %{$flags})
267			{
268			print $f,"+=",join(" ",@{$fv}),"\n";
269			}
270			}
271
272			foreach my $feature (qw( LIB LIBDIR INCLUDE USE ))
273			{
274			if (exists($self->{$feature}) && $#{$self->{$feature}} != -1)
275			{
276			print $feature,"=",join(" ",@{$self->{$feature}}),"\n";
277			}
278			}
279
280			# Finally, look for runtime vars:
281			if (exists($self->{'RUNTIME'}) && (my ($nkeys) = scalar(keys %{$self->{'RUNTIME'}}) > 0 ))
282			{
283	sashby	1.3	while (my ($rt,$val) = each %{$self->{'RUNTIME'}})
284	sashby	1.2	{
285			if ($rt =~ /:/)
286			{
287			my ($type,$name) = split(":",$rt);
288			print $name,"=",join(":",@$val),"\n";
289			}
290			else
291			{
292			print $rt,"=",join(":",@$val),"\n";
293			}
294			}
295			}
296
297			print "\n";
298			}
299
300
301			sub addreleasetoself()
302			{
303			my $self=shift;
304			# Go through the settings obtained so far (only from SELF) and, for
305			# every LIBDIR/INCLUDE/RUNTIME path, add another value with
306			# LOCALTOP==RELEASETOP:
307			my $relldir = [];
308			my $relinc = [];
309			my @locallibdirs = $self->libdir();
310			my @localincdirs = $self->include();
311
312			foreach my $libdir (@locallibdirs)
313			{
314			# Convert LOCAL to RELEASE top:
315			$libdir =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
316			push(@$relldir, $libdir);
317			}
318
319			# Add the new libdirs to our object:
320			$self->libdir($relldir);
321
322			foreach my $incdir (@localincdirs)
323			{
324			# Convert LOCAL to RELEASE top:
325			$incdir =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
326			push(@$relinc, $incdir);
327			}
328
329			# Add the new libdirs to our object:
330			$self->include($relinc);
331
332			# Handle runtime settings:
333			my $runtime=$self->runtime();
334
335			while (my ($rt,$val) = each %{$runtime})
336			{
337			# Only handle anything that's a PATH:
338			if ($rt =~ /:/)
339			{
340			my ($type,$name) = split(":",$rt);
341
342			if ($type eq 'PATH')
343			{
344			my @PATHS=@$val;
345			my $RELPATHS=[];
346
347			# Process the values for this path:
348			foreach my $rtpath (@PATHS)
349			{
350			$rtpath =~ s/$ENV{LOCALTOP}/$ENV{RELEASETOP}/g;
351			push(@$RELPATHS,$rtpath);
352			}
353
354			# Add the new settings:
355			$self->runtime($rt,$RELPATHS);
356			}
357			}
358			}
359
360			}
361
362			1;