ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/ToolData.pm
Revision: 1.8
Committed: Mon Sep 11 14:53:39 2006 UTC (18 years, 7 months ago) by sashby
Content type: text/plain
Branch: MAIN
CVS Tags: V2_2_3, forV2_2_3, V2_2_2, V2_2_2_pre4, V2_2_2_pre3, V2_2_2_pre2, V2_2_2_pre1, V2_2_2-pre1, V2_2_1, forV2_2_1, V2_2_0, sm100112, V2_1_4, V2_1_3, V2_1_2, V2_1_1, V2_1_0, V2_0_6, V2_0_5, V2_0_4, V2_0_4_relcand2, V2_0_4_relcand1, V2_0_3, V2_0_3_relcand3, V2_0_3_relcand2, V2_0_3_relcand1, V2_0_2, V2_0_2_relcand1, V2_0_1, V1_2_1b, V1_2_1a, V2_0_1_relcand4, V2_0_1_relcand3, V2_0_1_relcand2, V2_0_1_relcand1, V2_0_0_relcand4, V1_2_3, V2_0_0, V1_2_2, V1_2_2_relcand2, V1_2_2_relcand1, V2_0_0_relcand3, V2_0_0_relcand2, V2_0_0_relcand1, V1_2_1, V1_2_0, V1_2_0-cand11, V1_1_7, V1_1_6, V1_2_0-cand10, V1_1_5, V1_2_0-cand9, V1_2_0-cand8, V1_2_0-cand7, V1_2_0-cand6, V1_2_0-cand5, V1_2_0-cand4, V1_2_0-cand3, V1_2_0-cand2, V1_2_0-cand1, 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_0_3-p4, V1_1_0_cand3, V1_1_0_cand2, V1_1_0_cand1, HEAD_SM_071214, forV1_1_0, v103_xml_071106, V1_0_3-p3, V1_0_3-p2, V1_1_0, v110p1, V110p6, V110p5, V110p4, V110p3, before110xmlBRmerge, V110p2, V110p1, V1_0_3-p1, V1_0_3
Branch point for: SCRAM_V2_0, forBinLess_SCRAM, HEAD_BRANCH_SM_071214, v200branch, v103_with_xml
Changes since 1.7: +8 -6 lines
Log Message:
merged from v103_branch

File Contents

# 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.8 # Revision: $Id: ToolData.pm,v 1.7.2.2 2006/09/01 10:59:20 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 sashby 1.8 # Convert LOCAL to RELEASE top, quoting the LOCALTOP
328     # value in case funny characters have been used (e.g. ++):
329     $libdir =~ s/\Q$ENV{LOCALTOP}\E/$ENV{RELEASETOP}/g;
330 sashby 1.2 push(@$relldir, $libdir);
331     }
332    
333     # Add the new libdirs to our object:
334     $self->libdir($relldir);
335    
336     foreach my $incdir (@localincdirs)
337     {
338 sashby 1.8 # Convert LOCAL to RELEASE top, quoting the LOCALTOP
339     # value in case funny characters have been used (e.g. ++):
340     $incdir =~ s/\Q$ENV{LOCALTOP}\E/$ENV{RELEASETOP}/g;
341 sashby 1.2 push(@$relinc, $incdir);
342     }
343    
344     # Add the new libdirs to our object:
345     $self->include($relinc);
346    
347     # Handle runtime settings:
348     my $runtime=$self->runtime();
349    
350     while (my ($rt,$val) = each %{$runtime})
351     {
352     # Only handle anything that's a PATH:
353     if ($rt =~ /:/)
354     {
355     my ($type,$name) = split(":",$rt);
356    
357     if ($type eq 'PATH')
358     {
359     my @PATHS=@$val;
360     my $RELPATHS=[];
361    
362     # Process the values for this path:
363     foreach my $rtpath (@PATHS)
364     {
365 sashby 1.8 $rtpath =~ s/\Q$ENV{LOCALTOP}\E/$ENV{RELEASETOP}/g;
366 sashby 1.2 push(@$RELPATHS,$rtpath);
367     }
368    
369     # Add the new settings:
370     $self->runtime($rt,$RELPATHS);
371     }
372     }
373     }
374    
375     }
376    
377 sashby 1.6 sub allfeatures()
378     {
379     my $self=shift;
380     my @feature_vars=$self->list_variables();
381     my @features;
382     push (@features, @feature_vars, qw(LIB LIBDIR INCLUDE USE));
383    
384     # Make sure feature name is uppercase:
385     $feature =~ tr/a-z/A-Z/;
386     $feature_data={};
387     map
388     {
389     if (exists ($self->{$_}))
390     {
391     if (ref($self->{$_}) eq 'ARRAY')
392     {
393     $feature_data->{$_} = join(" ",@{$self->{$_}});
394     }
395     else
396     {
397     $feature_data->{$_} = $self->{$_}; # A string
398     }
399     }
400     } @features;
401     return $feature_data;
402     }
403    
404 sashby 1.7 sub reset()
405     {
406     my $self=shift;
407     my ($entryname)=@_;
408    
409     if (exists($self->{$entryname}))
410     {
411     $self->{$entryname} = undef;
412     }
413     }
414    
415 sashby 1.2 1;