src/Configuration/ConfigArea.pm

#
# ConfigArea.pm
#
# Written by Christopher Williams
#
# Description
# -----------
# creates and manages a configuration area
#
# Notes
# -------
# Persistency - remember to call the save method to make changes persistent
#
# Interface
# ---------
# new()                         : A new ConfigArea object
# name()                        : get/set project name
# setup(dir[,areaname])         : setup a fresh area in dir
# satellite(dir[,areaname])     : setup a satellite area in dir
# version()                     : get/set project version
# location([dir])               : set/return the location of the work area
# bootstrapfromlocation([location]) : bootstrap the object based on location.
#                                     no location specified - cwd used
#                                     return 0 if succesful 1 otherwise
# requirementsdoc()             : get set the requirements doc
# searchlocation([startdir])    : returns the location directory. search starts
#                                 from cwd if not specified
# scramversion()                : return the scram version associated with
#                                 area
# configurationdir()            : return the location of the project 
#                                 configuration directory
# copy(location)                : copy a configuration
# copysetup(location)           : copy the architecture specific tool setup
#                                 returns 0 if successful, 1 otherwise
# copyenv($ref)                 : copy the areas environment into the hashref
# toolbox()                     : return the areas toolbox object
# save()                        : save changes permanently
# linkto(location)              : link the current area to that at location
# unlinkarea()                  : destroy link (autosave)
# linkarea([ConfigArea])        : get/set a link from the current area to the apec Area Object
# archname()            : get/set a string to indicate architecture
# archdir()             : return the location of the administration arch dep 
#                         directory
# objectstore(["<"])            : return the objectStore object of the area
#                                 if called with temp - will set as undef
#                                 if it dosnt already exist - otherwise will
#                                 attempt to create it.
# - temporary
# align()                       : adjust hard paths to suit local loaction

package Configuration::ConfigArea;
require 5.004;
use URL::URLcache;
use Utilities::AddDir;
use Utilities::Verbose;
use ObjectUtilities::ObjectStore;
use Cwd;
@ISA=qw(Utilities::Verbose);

sub new {
        my $class=shift;
        my $self={};
        bless $self, $class;

        # data init
        $self->{admindir}=".SCRAM";
        $self->{cachedir}="cache";
        $self->{dbdir}="ObjectDB";
        undef $self->{linkarea};

        return $self;
}

sub cache {
        my $self=shift;

        my $exist=0;
        if ( @_ ) {
          my $cache=shift;
          if ( $cache!~/^</ ) {
            $self->{cache}=$cache;
          }
          $exist=1;
        }
        if ( ! defined $self->{cache} ) {
          my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
          if (  !$exist || ( -e $loc ) ) {
            $self->{cache}=URL::URLcache->new($loc);
          }
          else {
            $self->{cache}=undef;
          }
        }
        return $self->{cache};
}

sub objectstore {
        my $self=shift;

        my $exist="";
        if ( @_ ) {
          my $db=shift;
          if ( $db!~/^</ ) {
            $self->{dbstore}=cache;
          }
          $exist="<";
        }
        if ( ! defined $self->{dbstore} ) {
          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
          $self->{dbstore}=ObjectUtilities::ObjectStore->new($exist.$loc);
        }
        return $self->{dbstore}
}

sub name {
        my $self=shift;
        @_?$self->{name}=shift
          :$self->{name};
}

sub version {
        my $self=shift;
        @_?$self->{version}=shift
          :$self->{version};
}

sub setup {
        my $self=shift;
        my $location=shift;
        my $areaname;

        # -- check we have a project name and version
        my $name=$self->name();
        my $vers=$self->version();
        if ( ( ! defined $name ) && ( ! defined $version )) {
          $self->error("Set ConfigArea name and version before setup");
        }

        # -- check arguments and set location
        if ( ! defined $location ) {
          $self->error("ConfigArea: Cannot setup new area without a location");
        }
        if ( @_ ) {
          $areaname=shift;
        }
        if ( (! defined $areaname) || ( $areaname eq "" ) ) {
          # -- make up a name from the project name and version
          $vers=~s/^$name\_//;
          $areaname=$name."_".$vers;
        }
        my $arealoc=$location."/".$areaname;
        my $workloc=$arealoc."/".$self->{admindir};
        $self->verbose("Building at $arealoc");
        $self->location($arealoc);

        # -- create top level structure and work area
        AddDir::adddir($workloc);

        # -- add a cache
        $self->cache();

        # -- Save Environment File
        $self->_SaveEnvFile();

}

sub configurationdir {
        my $self=shift;
        if ( @_ ) {
          $self->{configurationdir}=shift;
        }
        return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
}

sub toolbox {
        my $self=shift;
        if ( ! defined $self->{toolbox} ) {
          $self->{toolbox}=BuildSystem::ToolBox->new($self);
        }
        return $self->{toolbox};
}

sub requirementsdoc {
        my $self=shift;
        if ( @_ ) {
          $self->{reqdoc}=shift;
        }
        if ( defined $self->{reqdoc} ) {
          return $self->location()."/".$self->{reqdoc};
        }
        else {
          return undef;
        }
}

sub scramversion {
        my $self=shift;
        if ( ! defined $self->{scramversion} ) {
          my $filename=$self->location()."/".$self->configurationdir()."/".
                                                        "scram_version";
          if ( -f $filename ) {
            use FileHandle;
            $fh=FileHandle->new();
            open ($fh, "<".$filename);
            my $version=<$fh>;
            chomp $version;
            $self->{scramversion}=$version;
            undef $fh;
          }
        }
        return $self->{scramversion};
}

sub bootstrapfromlocation {
        my $self=shift;

        my $rv=0;
        
        my $location;
        if ( ! defined ($location=$self->searchlocation(@_)) ) {
         $rv=1;
         $self->verbose("Unable to locate the top of local configuration area");
        }
        else {
         $self->location($location);
         $self->verbose("Found top ".$self->location());
         my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
         $self->_LoadEnvFile();
        }
        return $rv;
}

sub location {
        my $self=shift;

        if ( @_ ) {
          $self->{location}=shift;
        }
        elsif ( ! defined $self->{location} ) {
          # try and find the release location
          $self->{location}=$self->searchlocation();
        }
        return  $self->{location};
}

sub searchlocation {
        my $self=shift;

        #start search in current directory if not specified
        my $thispath;
        if ( @_ ) {
          $thispath=shift
        }
        else {
          $thispath=cwd();
        }
 
        my $rv=0;

        # chop off any files - we only want dirs
        if ( -f $thispath ) {
          $thispath=~s/(.*)\/.*/$1/;
        }
        Sloop:{
        do {
          $self->verbose("Searching $thispath");
          if ( -e "$thispath/".$self->{admindir} ) {
            $self->verbose("Found\n");
            $rv=1;
            last Sloop;
          }
        } while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) };

        return $rv?$thispath:undef;
}

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

sub archdir {
        my $self=shift;
        if ( @_ ) {
          $self->{archdir}=shift;
        }
        if ( ! defined $self->{archdir} ) {
         if ( defined $self->{archname} ) {
          $self->{archdir}=$self->location()."/".$self->{admindir}."/".
                                                        $self->{archname};
         }
         else {
          $self->error("ConfigArea : cannot create arch directory - ".
                                                "architecture name not set")
         }
        }
        return $self->{archdir};
}

sub satellite {
        my $self=shift;

        # -- create the sat object
        my $sat=Configuration::ConfigArea->new();
        $sat->name($self->name());
        $sat->version($self->version());
        $sat->requirementsdoc($self->{reqdoc});
        $sat->configurationdir($self->configurationdir());
        $sat->setup(@_);

        # -- copy across the cache and ObjectStore
        # -- make sure we dont try building new caches in release areas
        my $rcache=$self->cache("<");
        if ( defined $rcache ) {
          copy($rcache->location(),$sat->cache()->location());
        }

        # -- make sure we dont try building new objectstores in release areas
        my $rostore=$self->objectstore("<");
        if ( defined $rostore ) {
          copy($rostore->location(),$sat->objectstore()->location());
        }

        # and make sure in reinitialises
        undef ($sat->{cache});

        # -- link it to this area
        $sat->linkarea($self);
        
        # -- save it
        $sat->save();

        return $sat;
}

sub copy {
        my $self=shift;
        my $destination=shift;

        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir};
        AddDir::copydir($temp,"$destination/".$self->{admindir});
}

sub align {
        my $self=shift;
        use File::Copy;

        $self->_LoadEnvFile();
        my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
        my $tmpEnvfile=$Envfile.".bak";
        my $rel=$self->{ENV}{RELEASETOP};
        my $local=$self->location();

        rename( $Envfile, $tmpEnvfile );
        use FileHandle;
        my $fh=FileHandle->new();
        my $fout=FileHandle->new();
        open ( $fh, "<".$tmpEnvfile ) or
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!");
        open ( $fout, ">".$Envfile ) or
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!");
        while ( <$fh> ) {
          $_=~s/\Q$rel\L/$local/g;
          print $fout $_;
        }
        undef $fh;
        undef $fout;
}

sub copysetup {
        my $self=shift;
        my $dest=shift;

        my $rv=1;
        # copy across the admin dir
        my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
        my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
        if ( $temp ne $temp2 ) {
         if ( -d $temp ) {
          AddDir::copydir($temp,$temp2);
          $rv=0;
         }
        }
        return $rv;
}

sub copyenv {
        my $self=shift;
        my $hashref=shift;
        
        foreach $elem ( keys %{$self->{ENV}} ) {
           $$hashref{$elem}=$self->{ENV}{$elem};
        }
}

sub arch {
        my $self=shift;
        return $ENV{SCRAM_ARCH};
}

sub linkto {
        my $self=shift;
        my $location=shift;
        if ( -d $location ) {
        my $area=Configuration::ConfigArea->new();
        $area->bootstrapfromlocation($location);
        $self->linkarea($area);
        }
        else {
          $self->error("ConfigArea : Unable to link to non existing directory ".
                         $location);
        }
}

sub unlinkarea {
        my $self=shift;
        undef $self->{linkarea};
        $self->{linkarea}=undef;
        $self->save();
}

sub linkarea {
        my $self=shift;
        my $area=shift;
        if ( defined $area ) {
          $self->{linkarea}=$area;
        }
        return (defined $self->{linkarea} && $self->{linkarea} ne "")?
                        $self->{linkarea}:undef;
}

sub save {
        my $self=shift;
        $self->_SaveEnvFile();
}

# ---- support routines

sub _SaveEnvFile {
        my $self=shift;
        use FileHandle;
        my $fh=FileHandle->new();
        open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
                "Environment" ) or 
                $self->error("Cannot Open Environment file to Save ("
                                .$self->location().")\n $!"); 
        
        print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
        print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
        print $fh "projconfigdir=".$self->configurationdir()."\n";
        print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
        if ( defined $self->linkarea() ) {
          my $area=$self->linkarea()->location();
          if ( $area ne "" ) {
          print $fh "RELEASETOP=".$area."\n";
          }
        }
        undef $fh;
}


sub _LoadEnvFile {
        my $self=shift;

        use FileHandle;
        my $fh=FileHandle->new();
        open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
                "Environment" ) or 
                $self->error("Cannot find Environment file. Area Corrupted? ("
                                .$self->location().")\n $!"); 
        while ( <$fh> ) {
           chomp;
           next if /^#/;
           next if /^\s*$/ ;
           ($name, $value)=split /=/;
           eval "\$self->{ENV}{${name}}=\"$value\"";
        }
        undef $fh;
        
        # -- set internal variables appropriately
        if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
          $self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
        }
        if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
          $self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
        }
        if ( defined $self->{ENV}{"projconfigdir"} ) {
          $self->configurationdir($self->{ENV}{projconfigdir});
        }
        if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
          $self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
        }
        if ( ( defined $self->{ENV}{"RELEASETOP"} ) && 
                        ($self->{ENV}{"RELEASETOP"} ne $self->location())) {
          $self->linkto($self->{ENV}{"RELEASETOP"});
        }
        else {
          $self->{ENV}{"RELEASETOP"}=$self->location();
        }
}
Revision:	1.17
Committed:	Thu Sep 21 14:25:06 2000 UTC (24 years, 7 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.16:	+6 -3 lines
Log Message:	bug corrections from V0_15_0
#	User	Rev	Content
1	williamc	1.1	#
2			# ConfigArea.pm
3			#
4	williamc	1.14	# Written by Christopher Williams
5	williamc	1.1	#
6			# Description
7	williamc	1.9	# -----------
8			# creates and manages a configuration area
9			#
10	williamc	1.14	# Notes
11	williamc	1.9	# -------
12	williamc	1.14	# Persistency - remember to call the save method to make changes persistent
13	williamc	1.1	#
14			# Interface
15			# ---------
16	williamc	1.14	# new() : A new ConfigArea object
17			# name() : get/set project name
18			# setup(dir[,areaname]) : setup a fresh area in dir
19			# satellite(dir[,areaname]) : setup a satellite area in dir
20			# version() : get/set project version
21			# location([dir]) : set/return the location of the work area
22			# bootstrapfromlocation([location]) : bootstrap the object based on location.
23			# no location specified - cwd used
24			# return 0 if succesful 1 otherwise
25			# requirementsdoc() : get set the requirements doc
26	williamc	1.5	# searchlocation([startdir]) : returns the location directory. search starts
27			# from cwd if not specified
28	williamc	1.14	# scramversion() : return the scram version associated with
29			# area
30			# configurationdir() : return the location of the project
31			# configuration directory
32			# copy(location) : copy a configuration
33			# copysetup(location) : copy the architecture specific tool setup
34			# returns 0 if successful, 1 otherwise
35			# copyenv($ref) : copy the areas environment into the hashref
36			# toolbox() : return the areas toolbox object
37			# save() : save changes permanently
38			# linkto(location) : link the current area to that at location
39			# unlinkarea() : destroy link (autosave)
40	williamc	1.15	# linkarea([ConfigArea]) : get/set a link from the current area to the apec Area Object
41	williamc	1.14	# archname() : get/set a string to indicate architecture
42			# archdir() : return the location of the administration arch dep
43			# directory
44	williamc	1.16	# objectstore(["<"]) : return the objectStore object of the area
45			# if called with temp - will set as undef
46			# if it dosnt already exist - otherwise will
47			# attempt to create it.
48	williamc	1.14	# - temporary
49			# align() : adjust hard paths to suit local loaction
50	williamc	1.1
51			package Configuration::ConfigArea;
52			require 5.004;
53	williamc	1.14	use URL::URLcache;
54	williamc	1.1	use Utilities::AddDir;
55	williamc	1.14	use Utilities::Verbose;
56	williamc	1.1	use ObjectUtilities::ObjectStore;
57	williamc	1.6	use Cwd;
58	williamc	1.14	@ISA=qw(Utilities::Verbose);
59	williamc	1.1
60	williamc	1.14	sub new {
61			my $class=shift;
62			my $self={};
63			bless $self, $class;
64	williamc	1.5
65	williamc	1.14	# data init
66			$self->{admindir}=".SCRAM";
67			$self->{cachedir}="cache";
68			$self->{dbdir}="ObjectDB";
69			undef $self->{linkarea};
70	williamc	1.8
71	williamc	1.14	return $self;
72	williamc	1.1	}
73
74	williamc	1.14	sub cache {
75	williamc	1.9	my $self=shift;
76	williamc	1.16
77			my $exist=0;
78	williamc	1.14	if ( @_ ) {
79	williamc	1.16	my $cache=shift;
80			if ( $cache!~/^</ ) {
81			$self->{cache}=$cache;
82			}
83			$exist=1;
84	williamc	1.14	}
85	williamc	1.17	if ( ! defined $self->{cache} ) {
86	williamc	1.14	my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
87	williamc	1.17	if ( !$exist \|\| ( -e $loc ) ) {
88	williamc	1.16	$self->{cache}=URL::URLcache->new($loc);
89			}
90	williamc	1.17	else {
91			$self->{cache}=undef;
92			}
93	williamc	1.14	}
94			return $self->{cache};
95			}
96	williamc	1.9
97	williamc	1.14	sub objectstore {
98			my $self=shift;
99	williamc	1.16
100			my $exist="";
101	williamc	1.9	if ( @_ ) {
102	williamc	1.16	my $db=shift;
103			if ( $db!~/^</ ) {
104			$self->{dbstore}=cache;
105			}
106			$exist="<";
107	williamc	1.9	}
108	williamc	1.17	if ( ! defined $self->{dbstore} ) {
109	williamc	1.14	my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
110	williamc	1.16	$self->{dbstore}=ObjectUtilities::ObjectStore->new($exist.$loc);
111	williamc	1.9	}
112	williamc	1.14	return $self->{dbstore}
113	williamc	1.9	}
114
115	williamc	1.14	sub name {
116	williamc	1.9	my $self=shift;
117	williamc	1.14	@_?$self->{name}=shift
118			:$self->{name};
119	williamc	1.9	}
120	williamc	1.7
121	williamc	1.14	sub version {
122	williamc	1.6	my $self=shift;
123	williamc	1.14	@_?$self->{version}=shift
124			:$self->{version};
125	williamc	1.9	}
126	williamc	1.8
127	williamc	1.1	sub setup {
128			my $self=shift;
129	williamc	1.14	my $location=shift;
130			my $areaname;
131	williamc	1.1
132	williamc	1.14	# -- check we have a project name and version
133			my $name=$self->name();
134			my $vers=$self->version();
135			if ( ( ! defined $name ) && ( ! defined $version )) {
136			$self->error("Set ConfigArea name and version before setup");
137			}
138
139			# -- check arguments and set location
140	williamc	1.7	if ( ! defined $location ) {
141	williamc	1.14	$self->error("ConfigArea: Cannot setup new area without a location");
142	williamc	1.7	}
143	williamc	1.14	if ( @_ ) {
144			$areaname=shift;
145	williamc	1.6	}
146	williamc	1.14	if ( (! defined $areaname) \|\| ( $areaname eq "" ) ) {
147			# -- make up a name from the project name and version
148			$vers=~s/^$name\_//;
149			$areaname=$name."_".$vers;
150	williamc	1.1	}
151	williamc	1.14	my $arealoc=$location."/".$areaname;
152			my $workloc=$arealoc."/".$self->{admindir};
153			$self->verbose("Building at $arealoc");
154			$self->location($arealoc);
155	williamc	1.1
156	williamc	1.14	# -- create top level structure and work area
157			AddDir::adddir($workloc);
158	williamc	1.1
159	williamc	1.14	# -- add a cache
160			$self->cache();
161	williamc	1.5
162	williamc	1.14	# -- Save Environment File
163			$self->_SaveEnvFile();
164	williamc	1.3
165	williamc	1.9	}
166
167	williamc	1.14	sub configurationdir {
168	williamc	1.9	my $self=shift;
169	williamc	1.14	if ( @_ ) {
170			$self->{configurationdir}=shift;
171			}
172			return (defined $self->{configurationdir})?$self->{configurationdir}:undef;
173	williamc	1.9	}
174
175	williamc	1.14	sub toolbox {
176	williamc	1.3	my $self=shift;
177	williamc	1.14	if ( ! defined $self->{toolbox} ) {
178			$self->{toolbox}=BuildSystem::ToolBox->new($self);
179			}
180			return $self->{toolbox};
181	williamc	1.4	}
182
183	williamc	1.14	sub requirementsdoc {
184	williamc	1.5	my $self=shift;
185	williamc	1.14	if ( @_ ) {
186			$self->{reqdoc}=shift;
187			}
188			if ( defined $self->{reqdoc} ) {
189			return $self->location()."/".$self->{reqdoc};
190	williamc	1.12	}
191			else {
192	williamc	1.14	return undef;
193	williamc	1.12	}
194	williamc	1.5	}
195
196	williamc	1.14	sub scramversion {
197	williamc	1.4	my $self=shift;
198	williamc	1.14	if ( ! defined $self->{scramversion} ) {
199			my $filename=$self->location()."/".$self->configurationdir()."/".
200			"scram_version";
201			if ( -f $filename ) {
202			use FileHandle;
203			$fh=FileHandle->new();
204			open ($fh, "<".$filename);
205			my $version=<$fh>;
206			chomp $version;
207			$self->{scramversion}=$version;
208			undef $fh;
209			}
210			}
211			return $self->{scramversion};
212	williamc	1.1	}
213
214	williamc	1.14	sub bootstrapfromlocation {
215	williamc	1.1	my $self=shift;
216
217	williamc	1.14	my $rv=0;
218
219			my $location;
220			if ( ! defined ($location=$self->searchlocation(@_)) ) {
221			$rv=1;
222			$self->verbose("Unable to locate the top of local configuration area");
223	williamc	1.9	}
224			else {
225	williamc	1.14	$self->location($location);
226			$self->verbose("Found top ".$self->location());
227			my $infofile=$self->location()."/".$self->{admindir}."/ConfigArea.dat";
228			$self->_LoadEnvFile();
229	williamc	1.9	}
230	williamc	1.14	return $rv;
231	williamc	1.1	}
232
233			sub location {
234			my $self=shift;
235
236	williamc	1.5	if ( @_ ) {
237	williamc	1.6	$self->{location}=shift;
238	williamc	1.5	}
239			elsif ( ! defined $self->{location} ) {
240			# try and find the release location
241	williamc	1.9	$self->{location}=$self->searchlocation();
242	williamc	1.5	}
243			return $self->{location};
244			}
245
246			sub searchlocation {
247			my $self=shift;
248
249			#start search in current directory if not specified
250			my $thispath;
251	williamc	1.14	if ( @_ ) {
252			$thispath=shift
253			}
254			else {
255			$thispath=cwd();
256			}
257	williamc	1.5
258			my $rv=0;
259
260	williamc	1.14	# chop off any files - we only want dirs
261			if ( -f $thispath ) {
262			$thispath=~s/(.)\/./$1/;
263			}
264	williamc	1.6	Sloop:{
265			do {
266	williamc	1.14	$self->verbose("Searching $thispath");
267	williamc	1.8	if ( -e "$thispath/".$self->{admindir} ) {
268	williamc	1.14	$self->verbose("Found\n");
269	williamc	1.5	$rv=1;
270	williamc	1.6	last Sloop;
271	williamc	1.5	}
272	williamc	1.6	} while ( ($thispath=~s/(.)\/./$1/)=~/./ ) };
273	williamc	1.5
274			return $rv?$thispath:undef;
275	williamc	1.1	}
276
277	williamc	1.14	sub archname {
278	williamc	1.1	my $self=shift;
279	williamc	1.14	if ( @_ ) {
280			$self->{archname}=shift;
281			}
282			return $self->{archname};
283			}
284	williamc	1.1
285	williamc	1.14	sub archdir {
286			my $self=shift;
287			if ( @_ ) {
288			$self->{archdir}=shift;
289			}
290			if ( ! defined $self->{archdir} ) {
291			if ( defined $self->{archname} ) {
292			$self->{archdir}=$self->location()."/".$self->{admindir}."/".
293			$self->{archname};
294			}
295			else {
296			$self->error("ConfigArea : cannot create arch directory - ".
297			"architecture name not set")
298			}
299			}
300			return $self->{archdir};
301	williamc	1.1	}
302
303	williamc	1.14	sub satellite {
304	williamc	1.1	my $self=shift;
305	williamc	1.14
306			# -- create the sat object
307			my $sat=Configuration::ConfigArea->new();
308			$sat->name($self->name());
309			$sat->version($self->version());
310			$sat->requirementsdoc($self->{reqdoc});
311			$sat->configurationdir($self->configurationdir());
312			$sat->setup(@_);
313
314			# -- copy across the cache and ObjectStore
315	williamc	1.16	# -- make sure we dont try building new caches in release areas
316			my $rcache=$self->cache("<");
317			if ( defined $rcache ) {
318			copy($rcache->location(),$sat->cache()->location());
319			}
320
321			# -- make sure we dont try building new objectstores in release areas
322			my $rostore=$self->objectstore("<");
323			if ( defined $rostore ) {
324			copy($rostore->location(),$sat->objectstore()->location());
325			}
326	williamc	1.14
327			# and make sure in reinitialises
328			undef ($sat->{cache});
329
330			# -- link it to this area
331			$sat->linkarea($self);
332	williamc	1.1
333	williamc	1.14	# -- save it
334			$sat->save();
335
336			return $sat;
337	williamc	1.1	}
338
339	williamc	1.14	sub copy {
340	williamc	1.1	my $self=shift;
341	williamc	1.14	my $destination=shift;
342	williamc	1.1
343	williamc	1.14	# copy across the admin dir
344			my $temp=$self->location()."/".$self->{admindir};
345			AddDir::copydir($temp,"$destination/".$self->{admindir});
346	williamc	1.13	}
347
348	williamc	1.14	sub align {
349	williamc	1.13	my $self=shift;
350	williamc	1.14	use File::Copy;
351
352			$self->_LoadEnvFile();
353			my $Envfile=$self->location()."/".$self->{admindir}."/Environment";
354			my $tmpEnvfile=$Envfile.".bak";
355			my $rel=$self->{ENV}{RELEASETOP};
356			my $local=$self->location();
357
358			rename( $Envfile, $tmpEnvfile );
359			use FileHandle;
360			my $fh=FileHandle->new();
361			my $fout=FileHandle->new();
362			open ( $fh, "<".$tmpEnvfile ) or
363			$self->error("Cannot find Environment file. Area Corrupted? ("
364			.$self->location().")\n $!");
365			open ( $fout, ">".$Envfile ) or
366			$self->error("Cannot find Environment file. Area Corrupted? ("
367			.$self->location().")\n $!");
368			while ( <$fh> ) {
369			$_=~s/\Q$rel\L/$local/g;
370			print $fout $_;
371			}
372			undef $fh;
373			undef $fout;
374	williamc	1.1	}
375
376	williamc	1.14	sub copysetup {
377	williamc	1.9	my $self=shift;
378	williamc	1.14	my $dest=shift;
379
380			my $rv=1;
381			# copy across the admin dir
382			my $temp=$self->location()."/".$self->{admindir}."/".$self->arch();
383			my $temp2=$dest."/".$self->{admindir}."/".$self->arch();
384			if ( $temp ne $temp2 ) {
385			if ( -d $temp ) {
386			AddDir::copydir($temp,$temp2);
387			$rv=0;
388			}
389	williamc	1.9	}
390	williamc	1.14	return $rv;
391	williamc	1.9	}
392
393	williamc	1.14	sub copyenv {
394	williamc	1.9	my $self=shift;
395	williamc	1.14	my $hashref=shift;
396
397			foreach $elem ( keys %{$self->{ENV}} ) {
398			$$hashref{$elem}=$self->{ENV}{$elem};
399	williamc	1.9	}
400			}
401
402	williamc	1.14	sub arch {
403	williamc	1.9	my $self=shift;
404	williamc	1.14	return $ENV{SCRAM_ARCH};
405	williamc	1.9	}
406
407	williamc	1.14	sub linkto {
408	williamc	1.9	my $self=shift;
409	williamc	1.14	my $location=shift;
410			if ( -d $location ) {
411			my $area=Configuration::ConfigArea->new();
412			$area->bootstrapfromlocation($location);
413			$self->linkarea($area);
414			}
415			else {
416			$self->error("ConfigArea : Unable to link to non existing directory ".
417			$location);
418	williamc	1.9	}
419			}
420
421	williamc	1.14	sub unlinkarea {
422	williamc	1.9	my $self=shift;
423	williamc	1.14	undef $self->{linkarea};
424			$self->{linkarea}=undef;
425			$self->save();
426			}
427	williamc	1.9
428	williamc	1.14	sub linkarea {
429	williamc	1.1	my $self=shift;
430	williamc	1.14	my $area=shift;
431			if ( defined $area ) {
432			$self->{linkarea}=$area;
433			}
434			return (defined $self->{linkarea} && $self->{linkarea} ne "")?
435			$self->{linkarea}:undef;
436	williamc	1.1	}
437
438	williamc	1.14	sub save {
439	williamc	1.1	my $self=shift;
440	williamc	1.14	$self->_SaveEnvFile();
441	williamc	1.1	}
442
443	williamc	1.14	# ---- support routines
444	williamc	1.1
445	williamc	1.14	sub _SaveEnvFile {
446	williamc	1.9	my $self=shift;
447	williamc	1.14	use FileHandle;
448			my $fh=FileHandle->new();
449			open ( $fh, ">".$self->location()."/".$self->{admindir}."/".
450			"Environment" ) or
451			$self->error("Cannot Open Environment file to Save ("
452			.$self->location().")\n $!");
453
454			print $fh "SCRAM_PROJECTNAME=".$self->name()."\n";
455			print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n";
456			print $fh "projconfigdir=".$self->configurationdir()."\n";
457			print $fh "SCRAM_ProjReqsDoc=".$self->{reqdoc}."\n";
458			if ( defined $self->linkarea() ) {
459			my $area=$self->linkarea()->location();
460			if ( $area ne "" ) {
461			print $fh "RELEASETOP=".$area."\n";
462			}
463	williamc	1.9	}
464	williamc	1.14	undef $fh;
465	williamc	1.9	}
466
467	williamc	1.1
468	williamc	1.14	sub _LoadEnvFile {
469	williamc	1.9	my $self=shift;
470
471	williamc	1.14	use FileHandle;
472			my $fh=FileHandle->new();
473			open ( $fh, "<".$self->location()."/".$self->{admindir}."/".
474			"Environment" ) or
475			$self->error("Cannot find Environment file. Area Corrupted? ("
476			.$self->location().")\n $!");
477			while ( <$fh> ) {
478			chomp;
479			next if /^#/;
480			next if /^\s*$/ ;
481			($name, $value)=split /=/;
482			eval "\$self->{ENV}{${name}}=\"$value\"";
483			}
484			undef $fh;
485
486			# -- set internal variables appropriately
487			if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) {
488			$self->name($self->{ENV}{"SCRAM_PROJECTNAME"});
489			}
490			if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) {
491			$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"});
492			}
493			if ( defined $self->{ENV}{"projconfigdir"} ) {
494			$self->configurationdir($self->{ENV}{projconfigdir});
495			}
496			if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) {
497			$self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc});
498			}
499			if ( ( defined $self->{ENV}{"RELEASETOP"} ) &&
500			($self->{ENV}{"RELEASETOP"} ne $self->location())) {
501			$self->linkto($self->{ENV}{"RELEASETOP"});
502	williamc	1.9	}
503			else {
504	williamc	1.14	$self->{ENV}{"RELEASETOP"}=$self->location();
505	williamc	1.9	}
506			}