| 7 |
|
# ----------- |
| 8 |
|
# creates and manages a configuration area |
| 9 |
|
# |
| 10 |
< |
# Options |
| 10 |
> |
# Notes |
| 11 |
|
# ------- |
| 12 |
< |
# ConfigArea_location |
| 13 |
< |
# ConfigArea_name |
| 12 |
> |
# Persistency - remember to call the save method to make changes persistent |
| 13 |
|
# |
| 14 |
|
# Interface |
| 15 |
|
# --------- |
| 16 |
|
# 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 |
| 25 |
|
# requirementsdoc() : get set the requirements doc |
| 26 |
|
# searchlocation([startdir]) : returns the location directory. search starts |
| 27 |
|
# from cwd if not specified |
| 25 |
– |
# defaultdirname() : return the default directory name string |
| 28 |
|
# scramversion() : return the scram version associated with |
| 29 |
|
# area |
| 30 |
|
# configurationdir() : return the location of the project |
| 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 |
+ |
# linkarea([ConfigArea]) : link the current area to the apec Area Object |
| 41 |
|
# - temporary |
| 42 |
|
# align() : adjust hard paths to suit local loaction |
| 43 |
|
|
| 44 |
|
package Configuration::ConfigArea; |
| 45 |
|
require 5.004; |
| 46 |
+ |
use URL::URLcache; |
| 47 |
|
use Utilities::AddDir; |
| 48 |
|
use Utilities::Verbose; |
| 49 |
|
use Cwd; |
| 56 |
|
|
| 57 |
|
# data init |
| 58 |
|
$self->{admindir}=".SCRAM"; |
| 59 |
+ |
$self->{cachedir}="cache"; |
| 60 |
+ |
undef $self->{linkarea}; |
| 61 |
|
|
| 62 |
|
return $self; |
| 63 |
|
} |
| 64 |
|
|
| 65 |
+ |
sub cache { |
| 66 |
+ |
my $self=shift; |
| 67 |
+ |
if ( @_ ) { |
| 68 |
+ |
$self->{cache}=shift; |
| 69 |
+ |
} |
| 70 |
+ |
elsif ( ! defined $self->{cache} ) { |
| 71 |
+ |
my $loc=$self->location()."/".$self->{admindir}."/".$self->{cachedir}; |
| 72 |
+ |
$self->{cache}=URL::URLcache->new($loc); |
| 73 |
+ |
} |
| 74 |
+ |
return $self->{cache}; |
| 75 |
+ |
} |
| 76 |
+ |
|
| 77 |
+ |
sub name { |
| 78 |
+ |
my $self=shift; |
| 79 |
+ |
@_?$self->{name}=shift |
| 80 |
+ |
:$self->{name}; |
| 81 |
+ |
} |
| 82 |
+ |
|
| 83 |
+ |
sub version { |
| 84 |
+ |
my $self=shift; |
| 85 |
+ |
@_?$self->{version}=shift |
| 86 |
+ |
:$self->{version}; |
| 87 |
+ |
} |
| 88 |
+ |
|
| 89 |
+ |
sub setup { |
| 90 |
+ |
my $self=shift; |
| 91 |
+ |
my $location=shift; |
| 92 |
+ |
my $areaname; |
| 93 |
+ |
|
| 94 |
+ |
# -- check we have a project name and version |
| 95 |
+ |
my $name=$self->name(); |
| 96 |
+ |
my $vers=$self->version(); |
| 97 |
+ |
if ( ( ! defined $name ) && ( ! defined $version )) { |
| 98 |
+ |
$self->error("Set ConfigArea name and version before setup"); |
| 99 |
+ |
} |
| 100 |
+ |
|
| 101 |
+ |
# -- check arguments and set location |
| 102 |
+ |
if ( ! defined $location ) { |
| 103 |
+ |
$self->error("ConfigArea: Cannont setup area without a location"); |
| 104 |
+ |
} |
| 105 |
+ |
if ( @_ ) { |
| 106 |
+ |
$areaname=shift; |
| 107 |
+ |
} |
| 108 |
+ |
if ( (! defined $areaname) || ( $areaname eq "" ) ) { |
| 109 |
+ |
# -- make up a name from the project name and version |
| 110 |
+ |
$vers=~s/^$name\_//; |
| 111 |
+ |
$areaname=$name."_".$vers; |
| 112 |
+ |
} |
| 113 |
+ |
my $arealoc=$location."/".$areaname; |
| 114 |
+ |
my $workloc=$arealoc."/".$self->{admindir}; |
| 115 |
+ |
$self->verbose("Building at $arealoc"); |
| 116 |
+ |
$self->location($arealoc); |
| 117 |
+ |
|
| 118 |
+ |
# -- create top level structure and work area |
| 119 |
+ |
AddDir::adddir($workloc); |
| 120 |
+ |
|
| 121 |
+ |
# -- add a cache |
| 122 |
+ |
$self->cache(); |
| 123 |
+ |
|
| 124 |
+ |
# -- Save Environment File |
| 125 |
+ |
$self->_SaveEnvFile(); |
| 126 |
+ |
|
| 127 |
+ |
} |
| 128 |
+ |
|
| 129 |
|
sub configurationdir { |
| 130 |
|
my $self=shift; |
| 131 |
|
if ( @_ ) { |
| 132 |
|
$self->{configurationdir}=shift; |
| 133 |
|
} |
| 134 |
< |
if ( ! defined $self->{configurationdir} ) { |
| 62 |
< |
$self->_LoadEnvFile(); |
| 63 |
< |
$self->{configurationdir}=$self->{ENV}{projconfigdir}; |
| 64 |
< |
} |
| 65 |
< |
return $self->{configurationdir}; |
| 134 |
> |
return (defined $self->{configurationdir})?$self->{configurationdir}:undef; |
| 135 |
|
} |
| 136 |
|
|
| 137 |
|
sub toolbox { |
| 147 |
|
if ( @_ ) { |
| 148 |
|
$self->{reqdoc}=shift; |
| 149 |
|
} |
| 150 |
< |
if ( ! defined $self->{reqdoc} ) { |
| 82 |
< |
$self->_LoadEnvFile(); |
| 83 |
< |
$self->{reqdoc}=$self->{ENV}{SCRAM_ProjReqsDoc}; |
| 84 |
< |
} |
| 85 |
< |
return $self->{reqdoc}; |
| 150 |
> |
return (defined $self->{reqdoc})?$self->{reqdoc}:undef; |
| 151 |
|
} |
| 152 |
|
|
| 153 |
|
sub scramversion { |
| 231 |
|
return $rv?$thispath:undef; |
| 232 |
|
} |
| 233 |
|
|
| 234 |
+ |
sub satellite { |
| 235 |
+ |
my $self=shift; |
| 236 |
+ |
|
| 237 |
+ |
# -- create the sat object |
| 238 |
+ |
my $sat=Configuration::ConfigArea->new(); |
| 239 |
+ |
$sat->name($self->name()); |
| 240 |
+ |
$sat->version($self->version()); |
| 241 |
+ |
$sat->requirementsdoc($self->requirementsdoc()); |
| 242 |
+ |
$sat->configurationdir($self->configurationdir()); |
| 243 |
+ |
$sat->setup(@_); |
| 244 |
+ |
|
| 245 |
+ |
# -- copy across the cache |
| 246 |
+ |
copy($self->cache()->location(),$sat->cache()->location()); |
| 247 |
+ |
# and make sure in reinitialises |
| 248 |
+ |
undef ($sat->{cache}); |
| 249 |
+ |
|
| 250 |
+ |
# -- link it to this area |
| 251 |
+ |
$sat->linkarea($self); |
| 252 |
+ |
|
| 253 |
+ |
} |
| 254 |
+ |
|
| 255 |
|
sub copy { |
| 256 |
|
my $self=shift; |
| 257 |
|
my $destination=shift; |
| 320 |
|
return $ENV{SCRAM_ARCH}; |
| 321 |
|
} |
| 322 |
|
|
| 323 |
+ |
sub linkto { |
| 324 |
+ |
my $self=shift; |
| 325 |
+ |
my $location=shift; |
| 326 |
+ |
if ( -d $location ) { |
| 327 |
+ |
my $area=Configuration::ConfigArea->new(); |
| 328 |
+ |
$area->bootstrapfromlocation($location); |
| 329 |
+ |
$self->linkarea($area); |
| 330 |
+ |
} |
| 331 |
+ |
else { |
| 332 |
+ |
$self->error("ConfigArea : Unable to link to non existing directory ". |
| 333 |
+ |
$location); |
| 334 |
+ |
} |
| 335 |
+ |
} |
| 336 |
+ |
|
| 337 |
+ |
sub unlinkarea { |
| 338 |
+ |
my $self=shift; |
| 339 |
+ |
undef $self->{linkarea}; |
| 340 |
+ |
$self->{linkarea}=undef; |
| 341 |
+ |
$self->save(); |
| 342 |
+ |
} |
| 343 |
+ |
|
| 344 |
+ |
sub linkarea { |
| 345 |
+ |
my $self=shift; |
| 346 |
+ |
my $area=shift; |
| 347 |
+ |
if ( defined $area ) { |
| 348 |
+ |
$self->{linkarea}=$area; |
| 349 |
+ |
} |
| 350 |
+ |
return (defined $self->{linkarea} && $self->{linkarea} ne "")? |
| 351 |
+ |
$self->{linkarea}:undef; |
| 352 |
+ |
} |
| 353 |
+ |
|
| 354 |
+ |
sub save { |
| 355 |
+ |
my $self=shift; |
| 356 |
+ |
$self->_SaveEnvFile(); |
| 357 |
+ |
} |
| 358 |
+ |
|
| 359 |
|
# ---- support routines |
| 360 |
+ |
|
| 361 |
+ |
sub _SaveEnvFile { |
| 362 |
+ |
my $self=shift; |
| 363 |
+ |
use FileHandle; |
| 364 |
+ |
my $fh=FileHandle->new(); |
| 365 |
+ |
open ( $fh, ">".$self->location()."/".$self->{admindir}."/". |
| 366 |
+ |
"Environment" ) or |
| 367 |
+ |
$self->error("Cannot Open Environment file to Save (" |
| 368 |
+ |
.$self->location().")\n $!"); |
| 369 |
+ |
|
| 370 |
+ |
print $fh "SCRAM_PROJECTNAME=".$self->name()."\n"; |
| 371 |
+ |
print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n"; |
| 372 |
+ |
print $fh "projconfigdir=".$self->configurationdir()."\n"; |
| 373 |
+ |
print $fh "SCRAM_ProjReqsDoc=".$self->requirementsdoc()."\n"; |
| 374 |
+ |
if ( defined $self->linkarea() ) { |
| 375 |
+ |
my $area=$self->linkarea()->location(); |
| 376 |
+ |
if ( $area ne "" ) { |
| 377 |
+ |
print $fh "RELEASETOP=".$area."\n"; |
| 378 |
+ |
} |
| 379 |
+ |
} |
| 380 |
+ |
undef $fh; |
| 381 |
+ |
} |
| 382 |
+ |
|
| 383 |
+ |
|
| 384 |
|
sub _LoadEnvFile { |
| 385 |
|
my $self=shift; |
| 386 |
|
|
| 398 |
|
eval "\$self->{ENV}{${name}}=\"$value\""; |
| 399 |
|
} |
| 400 |
|
undef $fh; |
| 401 |
+ |
|
| 402 |
+ |
# -- set internal variables appropriately |
| 403 |
+ |
if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) { |
| 404 |
+ |
$self->name($self->{ENV}{"SCRAM_PROJECTNAME"}); |
| 405 |
+ |
} |
| 406 |
+ |
if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) { |
| 407 |
+ |
$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"}); |
| 408 |
+ |
} |
| 409 |
+ |
if ( defined $self->{ENV}{"projconfigdir"} ) { |
| 410 |
+ |
$self->configurationdir($self->{ENV}{projconfigdir}); |
| 411 |
+ |
} |
| 412 |
+ |
if ( defined $self->{ENV}{"SCRAM_ProjReqsDoc"} ) { |
| 413 |
+ |
$self->requirementsdoc($self->{ENV}{SCRAM_ProjReqsDoc}); |
| 414 |
+ |
} |
| 415 |
+ |
if ( ( defined $self->{ENV}{"RELEASETOP"} ) && |
| 416 |
+ |
($self->{ENV}{"RELEASETOP"} ne $self->location())) { |
| 417 |
+ |
$self->linkto($self->{ENV}{"RELEASETOP"}); |
| 418 |
+ |
} |
| 419 |
+ |
else { |
| 420 |
+ |
$self->{ENV}{"RELEASETOP"}=$self->location(); |
| 421 |
+ |
} |
| 422 |
|
} |
