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])        : link 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
# - 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;

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

sub _newcache {
        my $self=shift;
        my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir};
        $self->{cache}=URL::URLcache->new($loc);
        return $self->{cache};
}

sub _newobjectstore {
        my $self=shift;
        my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
        $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
        return $self->{dbstore};
}

sub objectstore {
        my $self=shift;

        if ( @_ ) {
            $self->{dbstore}=shift;
        }
        if ( ! defined $self->{dbstore} ) {
          my $loc=$self->location()."/".$self->{admindir}."/".$self->{dbdir};
          if ( -e $loc ) {
            $self->{dbstore}=ObjectUtilities::ObjectStore->new($loc);
          }
          else {
            $self->{dbstore}=undef;
          }
        }
        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->_newcache();

        # -- add an Objectstore
        $self->_newobjectstore();

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