src/BuildSystem/TreeItem.pm

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