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
#	Content
1	#____________________________________________________________________
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	$self->template($class);
68	}
69	else
70	{
71	return $self->{CLASS};
72	}
73	}
74
75	sub template()
76	{
77	my $self=shift;
78	my ($template)=@_;
79	if ($template)
80	{
81	$self->{TEMPLATE} = $template;
82	}
83	else
84	{
85	return $self->{TEMPLATE};
86	}
87	}
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	sub skip()
106	{
107	my $self=shift;
108	# Skip/unskip a directory:
109	@_ ? $self->{SKIP} = shift
110	: $self->{SKIP};
111	}
112
113	sub productstore()
114	{
115	my $self=shift;
116	@_ ? $self->{PRODUCTSTORES} = shift
117	: $self->{PRODUCTSTORES};
118	}
119
120	sub name()
121	{
122	my $self=shift;
123	my $n=shift;
124	if(defined $n){$self->{NAME}=$n; return;}
125
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	elsif ($self->{CLASS} eq 'DOMAIN')
142	{
143	# We want the name of the domain:
144	($self->{NAME}) = ($classdir =~ m\|^./(.)?$\|);
145	}
146	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	{
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
174	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	#$meta->clean(qw( EXPORT DEFINED_GROUP CLASSPATH SKIPPEDDIRS ));
297	$self->{RAWDATA} = $meta;
298	}
299	else
300	{
301	return $self->{RAWDATA};
302	}
303	}
304
305	sub branchdata()
306	{
307	my $self=shift;
308	@_ ? $self->{RAWDATA} = shift
309	: $self->{RAWDATA};
310	}
311
312	sub clearmeta()
313	{
314	my $self=shift;
315	delete $self->{RAWDATA};
316	}
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	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	sub clean()
431	{
432	my $self=shift;
433	delete $self->{RAWDATA};
434	}
435
436	1;