src/BuildSystem/TreeItem.pm

#____________________________________________________________________ 
# File: TreeItem.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2004-06-24 12:24:57+0200
# Revision: $Id: TreeItem.pm,v 1.6 2007/12/14 09:03:48 muzaffar Exp $ 
#
# Copyright: 2004 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package BuildSystem::TreeItem;
require 5.004;
use Exporter;
@ISA=qw(Exporter);
@EXPORT_OK=qw( );

sub new()
  ###############################################################
  # new                                                         #
  ###############################################################
  # modified : Thu Jun 24 12:25:02 2004 / SFA                   #
  # params   :                                                  #
  #          :                                                  #
  # function :                                                  #
  #          :                                                  #
  ###############################################################
  {
  my $proto=shift;
  my $class=ref($proto) || $proto;
  my $self={};
 
  bless $self,$class;
  $self->{METABF} = [];
  return $self;
  }

sub safepath()
   {
   my $self=shift;
   
   if ($self->{PATH})
      {
      # Make a safe path from our path:
      ($safepath = $self->{PATH}) =~ s|/|_|g;
      $self->{SAFEPATH} = $safepath;
      }

   # Return the safe version of the current path:
   return $self->{SAFEPATH};
   }

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

sub class()
   {
   my $self=shift;
   my ($class)=@_;
   # Set/return the part of the ClassPath that matched a template name.
   # Note that we store it as uppercase! The template name is, of course,
   # exactly as it appears in the ClassPath:
   if ($class)
      {
      $self->{CLASS} = uc($class);
      $self->template($class);
      }
   else
      {
      return $self->{CLASS};
      }
   }

sub template()
   {
   my $self=shift;
   my ($template)=@_;
   if ($template)
      {
      $self->{TEMPLATE} = $template;
      }
   else
      {
      return $self->{TEMPLATE};
      }
   }

sub classdir()
   {
   my $self=shift;
   # Set/return the part of the ClassPath that matched:
   @_ ? $self->{CLASSDIR} = shift
      : $self->{CLASSDIR};
   }

sub suffix()
   {
   my $self=shift;
   # Set/return the part of the ClassPath that didn't match:
   @_ ? $self->{SUFFIX} = shift
      : $self->{SUFFIX};
   }

sub skip()
   {
   my $self=shift;
   # Skip/unskip a directory:
   @_ ? $self->{SKIP} = shift
      : $self->{SKIP};
   }

sub productstore()
   {
   my $self=shift;
   @_ ? $self->{PRODUCTSTORES} = shift
      : $self->{PRODUCTSTORES};
   }
   
sub name()
   {
   my $self=shift;
   my $n=shift;
   if(defined $n){$self->{NAME}=$n; return;}

   # Don't bother doing any work if the NAME exists already - just return it:
   if (! exists($self->{NAME}))
      {
      my $classdir = $self->{CLASSDIR}; # Make a copy for protection      
      # Here we want to return a name that can be used in the templates.
      # The name could be the name of the subsystem or the package:
      if ($self->{CLASS} eq 'PACKAGE')
         {
         ($self->{NAME}) = ($classdir =~ m|^.*/(.*)?$|);         
         }
      elsif ($self->{CLASS} eq 'SUBSYSTEM')
         {
         # We want the name of the subsystem:
         ($self->{NAME}) = ($classdir =~ m|^.*/(.*)?$|);
         }
      elsif ($self->{CLASS} eq 'DOMAIN')
         {
         # We want the name of the domain:
         ($self->{NAME}) = ($classdir =~ m|^.*/(.*)?$|);
         }
      elsif ($self->{CLASS} eq 'LIBRARY')
         {
         #use SCRAM::ProductName;
         #my $n = &SCRAM::ProductName::get_safename($classdir);
         my $n="";
         if ($n ne "")
            {
            $self->{NAME} = $n;
            }
         }
      if (! exists($self->{NAME}))
         {
         # Here we have a path that ends in src/bin/test/doc etc. (for real
         # build products). We still want to return the package name:
         ($self->{NAME}) = ($classdir =~ m|^.*/(.*)/.*?$|);
         }
      }
   else  
      {
      return $self->{NAME};
      }
   }

sub rawdata()
   {
   my $self=shift;
   my ($rawdata)=@_;

   if ($rawdata)
      {
      $self->{RAWDATA} = $rawdata;
      return $self;
      }
   else
      {      
      if (exists ($self->{RAWDATA}))
         {
         return $self->{RAWDATA};
         }
      else
         {
         return undef;
         }
      }
   }

sub parent()
   {
   my $self=shift;
   my ($datapath)=@_;
   my $thisloc;

   if ($datapath)
      {
      # We don't want to store the parent of src (it has no parent):
      if ($datapath eq $ENV{SCRAM_SOURCEDIR})
         {
         return;
         }
      
      # Given a path like a/b/c we want to return the parent a/b:
      ($thisloc) = ($datapath =~ m|^(.*)/.*?$|);

      if ($thisloc ne '')
         {
         $self->{PARENT} = $thisloc;
         }
      else
         {
         $self->{PARENT} = $ENV{SCRAM_SOURCEDIR};
         }
      }
   else
      {
      (exists ($self->{PARENT})) ? return $self->{PARENT} : '' ;
      }
   }

sub children()
   {
   my $self=shift;
   my ($filecache) = @_;
   my $safesubs=[];
   
   if ($filecache)
      {
      if (exists $filecache->{$self->{PATH}})
         {
         # Get array ref:
         my @subdirs=@{$filecache->{$self->{PATH}}};
         my $children=[];

         foreach my $SD (@subdirs)
            {
            # We don't want timestamps or CVS directories:
            if ($SD !~ /.*CVS/ && $SD !~ /^[0-9]+$/)
               {
               my $datapath;
               # We want to store the data paths for the children:
               ($datapath = $SD) =~ s|^\Q$ENV{SCRAM_SOURCEDIR}\L/||;
               push(@$children,$datapath);
               push(@$safesubs,$SD);
               }
            }
         
         # Store the children only if there were some:
         if ($#$children > -1)
            {
            $self->{CHILDREN} = $children;
            # Make safe versions of each subdir:
            $self->safesubdirs(@$safesubs);
            }
         }
      }
   else
      {
      (exists ($self->{CHILDREN})) ? return @{$self->{CHILDREN}} : undef ;
      }
   }

sub metabf()
   {
   my $self=shift;
   my (@metabf) = @_;

   if (@metabf)
      {      
      foreach my $mbf (@metabf)
         {
         if (! grep($mbf eq $_, @{$self->{METABF}})) # Remove duplicates!!
            {
            push(@{$self->{METABF}}, $mbf);
            }
         }
      }
   else
      {
      return $self->{METABF};
      }
   }

sub branchmetadata()
   {
   my $self=shift;
   my ($meta)=@_;

   # Method to store/retrieve data for complete branch:
   if ($meta)
      {
      # Delete unneeded entries:
      #$meta->clean(qw( EXPORT DEFINED_GROUP CLASSPATH SKIPPEDDIRS ));
      $self->{RAWDATA} = $meta;
      }
   else
      {
      return $self->{RAWDATA};
      }
   }

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

sub clearmeta()
   {
   my $self=shift;
   delete $self->{RAWDATA};
   }

sub updatechildlist()
   {
   my $self=shift;
   my ($child)=@_;

   # Loop over list of children, removing the one specified:
   my $uchildren = [];
   my $uchilddirs = [];
   
   foreach my $c (@{$self->{CHILDREN}})
      {
      if ($c ne $child)
         {
         push(@$uchildren, $c);
         # Convert this datapath into a path to be converted to a safepath:
         push(@{$uchilddirs}, 'src/'.$c);
         }
      else
         {
         print "TreeItem: Removing $child from parents child list.","\n",if ($ENV{SCRAM_DEBUG});
         }
      }
   
   # Now store the new list of children:
   $self->{CHILDREN} = [ @$uchildren ];
   # Update the safe subdir names:
   $self->updatesafesubdirs(@$uchilddirs);   
   }

sub updatesafesubdirs()
   {
   my $self=shift;
   my (@subdirs)=@_;
   # Reset the SAFESUBDIRS to the list of subdirs given:
   delete $self->{SAFESUBDIRS};
   $self->safesubdirs(@subdirs);
   }

sub updateparentstatus()
   {
   my $self=shift;
   my ($child) = @_;

   # Add child to CHILDREN (check to make sure it isn't there already):
   if (exists($self->{CHILDREN}))
      {
      if (! grep($child eq $_, @{$self->{CHILDREN}})) # Remove duplicates!!
         {
         push(@{$self->{CHILDREN}},$child);
         }
      }
   else
      {
      $self->{CHILDREN} = [ $child ];
      }

   # Add the SAFESUBDIRS:
   my $safedir = [ 'src/'.$child ];
   $self->safesubdirs(@$safedir);
   }

sub safesubdirs()
   {
   my $self=shift;
   my (@subdirs)=@_;
   
   if (@subdirs)
      {      
      # If we already have SAFESUBDIRS, add to them, don't overwrite:
      if (exists($self->{SAFESUBDIRS}))
         {
         # Store the safe paths of all the children:
         foreach my $sd (@subdirs)
            {
            $sd =~ s|/|_|g;
            if (! grep($sd eq $_, @{$self->{SAFESUBDIRS}})) # Remove duplicates!!
               {
               push(@{$self->{SAFESUBDIRS}}, $sd);
               }
            }
         }
      else
         {
         my $safesubs=[];
         map {$_ =~ s|/|_|g; push(@$safesubs, $_)} @subdirs;
         $self->{SAFESUBDIRS} = $safesubs;
         }
      }
   else
      {
      # Return formatted as a string:
      return join(" ",@{$self->{SAFESUBDIRS}});
      }
   }

sub scramprojectbases()
   {
   my $self=shift;
   # This is needed at project level only:
   @_ ? $self->{SCRAM_PROJECT_BASES} = shift
      : $self->{SCRAM_PROJECT_BASES};
   }

sub publictype()
   {
   my $self=shift;
   my $type=shift;
   if (defined $type) {$self->{PUBLIC} = $type; return;}
   if(exists $self->{PUBLIC}){return $self->{PUBLIC};}
   return 0;
   }

sub clean()
   {
   my $self=shift;
   delete $self->{RAWDATA};
   }

1;
Revision:	1.6.2.1
Committed:	Fri Feb 15 14:58:01 2008 UTC (17 years, 2 months ago) by muzaffar
Content type:	text/plain
Branch:	forBinLess_SCRAM
CVS Tags:	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_2_0-cand10, 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
Branch point for:	SCRAM_V2_0
Changes since 1.6:	+11 -12 lines
Log Message:	binary independent scram in forBinLess_SCRAM branch
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
2			# File: TreeItem.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2004-06-24 12:24:57+0200
7	muzaffar	1.6.2.1	# Revision: $Id: TreeItem.pm,v 1.6 2007/12/14 09:03:48 muzaffar Exp $
8	sashby	1.2	#
9			# Copyright: 2004 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package BuildSystem::TreeItem;
13			require 5.004;
14			use Exporter;
15			@ISA=qw(Exporter);
16			@EXPORT_OK=qw( );
17
18			sub new()
19			###############################################################
20			# new #
21			###############################################################
22			# modified : Thu Jun 24 12:25:02 2004 / SFA #
23			# params : #
24			# : #
25			# function : #
26			# : #
27			###############################################################
28			{
29			my $proto=shift;
30			my $class=ref($proto) \|\| $proto;
31			my $self={};
32
33			bless $self,$class;
34			$self->{METABF} = [];
35			return $self;
36			}
37
38			sub safepath()
39			{
40			my $self=shift;
41
42			if ($self->{PATH})
43			{
44			# Make a safe path from our path:
45			($safepath = $self->{PATH}) =~ s\|/\|_\|g;
46			$self->{SAFEPATH} = $safepath;
47			}
48
49			# Return the safe version of the current path:
50			return $self->{SAFEPATH};
51			}
52
53			sub path()
54			{
55			my $self=shift;
56			@_ ? $self->{PATH} = shift
57			: $self->{PATH};
58			}
59
60			sub class()
61			{
62			my $self=shift;
63			my ($class)=@_;
64			# Set/return the part of the ClassPath that matched a template name.
65			# Note that we store it as uppercase! The template name is, of course,
66			# exactly as it appears in the ClassPath:
67			if ($class)
68			{
69			$self->{CLASS} = uc($class);
70	muzaffar	1.6.2.1	$self->template($class);
71	sashby	1.2	}
72			else
73			{
74			return $self->{CLASS};
75			}
76			}
77
78			sub template()
79			{
80			my $self=shift;
81	muzaffar	1.6.2.1	my ($template)=@_;
82			if ($template)
83			{
84			$self->{TEMPLATE} = $template;
85			}
86			else
87			{
88			return $self->{TEMPLATE};
89			}
90	sashby	1.2	}
91
92			sub classdir()
93			{
94			my $self=shift;
95			# Set/return the part of the ClassPath that matched:
96			@_ ? $self->{CLASSDIR} = shift
97			: $self->{CLASSDIR};
98			}
99
100			sub suffix()
101			{
102			my $self=shift;
103			# Set/return the part of the ClassPath that didn't match:
104			@_ ? $self->{SUFFIX} = shift
105			: $self->{SUFFIX};
106			}
107
108	sashby	1.3	sub skip()
109			{
110			my $self=shift;
111			# Skip/unskip a directory:
112			@_ ? $self->{SKIP} = shift
113			: $self->{SKIP};
114			}
115
116	muzaffar	1.5	sub productstore()
117			{
118			my $self=shift;
119			@_ ? $self->{PRODUCTSTORES} = shift
120			: $self->{PRODUCTSTORES};
121			}
122
123	sashby	1.2	sub name()
124			{
125			my $self=shift;
126	muzaffar	1.5	my $n=shift;
127			if(defined $n){$self->{NAME}=$n; return;}
128	sashby	1.2
129			# Don't bother doing any work if the NAME exists already - just return it:
130			if (! exists($self->{NAME}))
131			{
132			my $classdir = $self->{CLASSDIR}; # Make a copy for protection
133			# Here we want to return a name that can be used in the templates.
134			# The name could be the name of the subsystem or the package:
135			if ($self->{CLASS} eq 'PACKAGE')
136			{
137			($self->{NAME}) = ($classdir =~ m\|^./(.)?$\|);
138			}
139			elsif ($self->{CLASS} eq 'SUBSYSTEM')
140			{
141			# We want the name of the subsystem:
142			($self->{NAME}) = ($classdir =~ m\|^./(.)?$\|);
143			}
144	sashby	1.4	elsif ($self->{CLASS} eq 'DOMAIN')
145			{
146			# We want the name of the domain:
147			($self->{NAME}) = ($classdir =~ m\|^./(.)?$\|);
148			}
149	muzaffar	1.5	elsif ($self->{CLASS} eq 'LIBRARY')
150			{
151			#use SCRAM::ProductName;
152			#my $n = &SCRAM::ProductName::get_safename($classdir);
153			my $n="";
154			if ($n ne "")
155			{
156			$self->{NAME} = $n;
157			}
158			}
159			if (! exists($self->{NAME}))
160	sashby	1.2	{
161			# Here we have a path that ends in src/bin/test/doc etc. (for real
162			# build products). We still want to return the package name:
163			($self->{NAME}) = ($classdir =~ m\|^./(.)/.*?$\|);
164			}
165			}
166			else
167			{
168			return $self->{NAME};
169			}
170			}
171
172			sub rawdata()
173			{
174			my $self=shift;
175			my ($rawdata)=@_;
176	sashby	1.3
177	sashby	1.2	if ($rawdata)
178			{
179			$self->{RAWDATA} = $rawdata;
180			return $self;
181			}
182			else
183			{
184			if (exists ($self->{RAWDATA}))
185			{
186			return $self->{RAWDATA};
187			}
188			else
189			{
190			return undef;
191			}
192			}
193			}
194
195			sub parent()
196			{
197			my $self=shift;
198			my ($datapath)=@_;
199			my $thisloc;
200
201			if ($datapath)
202			{
203			# We don't want to store the parent of src (it has no parent):
204			if ($datapath eq $ENV{SCRAM_SOURCEDIR})
205			{
206			return;
207			}
208
209			# Given a path like a/b/c we want to return the parent a/b:
210			($thisloc) = ($datapath =~ m\|^(.)/.?$\|);
211
212			if ($thisloc ne '')
213			{
214			$self->{PARENT} = $thisloc;
215			}
216			else
217			{
218			$self->{PARENT} = $ENV{SCRAM_SOURCEDIR};
219			}
220			}
221			else
222			{
223			(exists ($self->{PARENT})) ? return $self->{PARENT} : '' ;
224			}
225			}
226
227			sub children()
228			{
229			my $self=shift;
230			my ($filecache) = @_;
231			my $safesubs=[];
232
233			if ($filecache)
234			{
235			if (exists $filecache->{$self->{PATH}})
236			{
237			# Get array ref:
238			my @subdirs=@{$filecache->{$self->{PATH}}};
239			my $children=[];
240
241			foreach my $SD (@subdirs)
242			{
243			# We don't want timestamps or CVS directories:
244			if ($SD !~ /.*CVS/ && $SD !~ /^[0-9]+$/)
245			{
246			my $datapath;
247			# We want to store the data paths for the children:
248			($datapath = $SD) =~ s\|^\Q$ENV{SCRAM_SOURCEDIR}\L/\|\|;
249			push(@$children,$datapath);
250			push(@$safesubs,$SD);
251			}
252			}
253
254			# Store the children only if there were some:
255			if ($#$children > -1)
256			{
257			$self->{CHILDREN} = $children;
258			# Make safe versions of each subdir:
259			$self->safesubdirs(@$safesubs);
260			}
261			}
262			}
263			else
264			{
265			(exists ($self->{CHILDREN})) ? return @{$self->{CHILDREN}} : undef ;
266			}
267			}
268
269			sub metabf()
270			{
271			my $self=shift;
272			my (@metabf) = @_;
273
274			if (@metabf)
275			{
276			foreach my $mbf (@metabf)
277			{
278			if (! grep($mbf eq $_, @{$self->{METABF}})) # Remove duplicates!!
279			{
280			push(@{$self->{METABF}}, $mbf);
281			}
282			}
283			}
284			else
285			{
286			return $self->{METABF};
287			}
288			}
289
290			sub branchmetadata()
291			{
292			my $self=shift;
293			my ($meta)=@_;
294
295			# Method to store/retrieve data for complete branch:
296			if ($meta)
297			{
298			# Delete unneeded entries:
299	muzaffar	1.5	#$meta->clean(qw( EXPORT DEFINED_GROUP CLASSPATH SKIPPEDDIRS ));
300			$self->{RAWDATA} = $meta;
301	sashby	1.2	}
302			else
303			{
304	muzaffar	1.5	return $self->{RAWDATA};
305	sashby	1.2	}
306			}
307
308			sub branchdata()
309			{
310			my $self=shift;
311	muzaffar	1.5	@_ ? $self->{RAWDATA} = shift
312			: $self->{RAWDATA};
313	sashby	1.2	}
314
315			sub clearmeta()
316			{
317			my $self=shift;
318	muzaffar	1.5	delete $self->{RAWDATA};
319	sashby	1.2	}
320
321			sub updatechildlist()
322			{
323			my $self=shift;
324			my ($child)=@_;
325
326			# Loop over list of children, removing the one specified:
327			my $uchildren = [];
328			my $uchilddirs = [];
329
330			foreach my $c (@{$self->{CHILDREN}})
331			{
332			if ($c ne $child)
333			{
334			push(@$uchildren, $c);
335			# Convert this datapath into a path to be converted to a safepath:
336			push(@{$uchilddirs}, 'src/'.$c);
337			}
338			else
339			{
340			print "TreeItem: Removing $child from parents child list.","\n",if ($ENV{SCRAM_DEBUG});
341			}
342			}
343
344			# Now store the new list of children:
345			$self->{CHILDREN} = [ @$uchildren ];
346			# Update the safe subdir names:
347			$self->updatesafesubdirs(@$uchilddirs);
348			}
349
350			sub updatesafesubdirs()
351			{
352			my $self=shift;
353			my (@subdirs)=@_;
354			# Reset the SAFESUBDIRS to the list of subdirs given:
355			delete $self->{SAFESUBDIRS};
356			$self->safesubdirs(@subdirs);
357			}
358
359			sub updateparentstatus()
360			{
361			my $self=shift;
362			my ($child) = @_;
363
364			# Add child to CHILDREN (check to make sure it isn't there already):
365			if (exists($self->{CHILDREN}))
366			{
367			if (! grep($child eq $_, @{$self->{CHILDREN}})) # Remove duplicates!!
368			{
369			push(@{$self->{CHILDREN}},$child);
370			}
371			}
372			else
373			{
374			$self->{CHILDREN} = [ $child ];
375			}
376
377			# Add the SAFESUBDIRS:
378			my $safedir = [ 'src/'.$child ];
379			$self->safesubdirs(@$safedir);
380			}
381
382			sub safesubdirs()
383			{
384			my $self=shift;
385			my (@subdirs)=@_;
386
387			if (@subdirs)
388			{
389			# If we already have SAFESUBDIRS, add to them, don't overwrite:
390			if (exists($self->{SAFESUBDIRS}))
391			{
392			# Store the safe paths of all the children:
393			foreach my $sd (@subdirs)
394			{
395			$sd =~ s\|/\|_\|g;
396			if (! grep($sd eq $_, @{$self->{SAFESUBDIRS}})) # Remove duplicates!!
397			{
398			push(@{$self->{SAFESUBDIRS}}, $sd);
399			}
400			}
401			}
402			else
403			{
404			my $safesubs=[];
405			map {$_ =~ s\|/\|_\|g; push(@$safesubs, $_)} @subdirs;
406			$self->{SAFESUBDIRS} = $safesubs;
407			}
408			}
409			else
410			{
411			# Return formatted as a string:
412			return join(" ",@{$self->{SAFESUBDIRS}});
413			}
414			}
415
416			sub scramprojectbases()
417			{
418			my $self=shift;
419			# This is needed at project level only:
420			@_ ? $self->{SCRAM_PROJECT_BASES} = shift
421			: $self->{SCRAM_PROJECT_BASES};
422			}
423
424	muzaffar	1.5	sub publictype()
425			{
426			my $self=shift;
427			my $type=shift;
428			if (defined $type) {$self->{PUBLIC} = $type; return;}
429			if(exists $self->{PUBLIC}){return $self->{PUBLIC};}
430			return 0;
431			}
432
433	sashby	1.2	sub clean()
434			{
435			my $self=shift;
436	muzaffar	1.5	delete $self->{RAWDATA};
437	sashby	1.2	}
438
439			1;