1 |
– |
# |
2 |
– |
# ConfigArea.pm |
3 |
– |
# |
4 |
– |
# Originally Written by Christopher Williams |
5 |
– |
# |
6 |
– |
# Description |
7 |
– |
# ----------- |
8 |
– |
# creates and manages a configuration area |
9 |
– |
# |
10 |
– |
# Options |
11 |
– |
# ------- |
12 |
– |
# ConfigArea_location |
13 |
– |
# ConfigArea_name |
14 |
– |
# |
15 |
– |
# Interface |
16 |
– |
# --------- |
17 |
– |
# new(ActiveConfig) : A new ConfigArea object |
18 |
– |
# setup() : setup the configuration area |
19 |
– |
# location([dir]) : set/return the location of the area |
20 |
– |
# version([version]) : set/return the version of the area |
21 |
– |
# name([name]) : set/return the name of the area |
22 |
– |
# store(location) : store data in file location |
23 |
– |
# restore(location) : restore data from file location |
24 |
– |
# meta() : return a description string of the area |
25 |
– |
# addconfigitem(url) : add a new item to the area |
26 |
– |
# configitem(@keys) : return a list of fig items that match |
27 |
– |
# the keys - all if left blank |
28 |
– |
# parentstore() : set/return the parent ObjectStore |
29 |
– |
# basearea(ConfigArea) : Set/Get the base area |
30 |
– |
# freebase() : Remove any link to a base area |
31 |
– |
# bootstrapfromlocation([location]): bootstrap the object based on location. |
32 |
– |
# no location specified - cwd used |
33 |
– |
# searchlocation([startdir]) : returns the location directory. search starts |
34 |
– |
# from cwd if not specified |
35 |
– |
# defaultdirname() : return the default directory name string |
36 |
– |
# copy(location) : make a copy of the current area at the |
37 |
– |
# specified location - defaults to cwd/default |
38 |
– |
# if not specified . ConfigArea_name, |
39 |
– |
# ConfigArea_location also override . |
40 |
– |
# Return an object representing the area |
41 |
– |
# satellite() : make a satellite area based on $self |
42 |
– |
# arch([archobj]) : Set/get the architecture object |
43 |
– |
# structure(name) : return the object corresponding to the |
44 |
– |
# structure name |
45 |
– |
# structurelist() : return list of structure objectS |
46 |
– |
# downloadtotop(dir,url) : download the url to a dir in the config area |
47 |
– |
# |
48 |
– |
|
1 |
|
package Configuration::ConfigArea; |
50 |
– |
use ActiveDoc::ActiveDoc; |
2 |
|
require 5.004; |
3 |
|
use Utilities::AddDir; |
4 |
< |
use ObjectUtilities::ObjectStore; |
54 |
< |
use Configuration::ConfigStore; |
55 |
< |
use Configuration::ActiveDoc_arch; |
4 |
> |
use Utilities::Verbose; |
5 |
|
use Cwd; |
6 |
< |
@ISA=qw(Configuration::ActiveDoc_arch ObjectUtilities::StorableObject); |
58 |
< |
|
59 |
< |
sub init { |
60 |
< |
my $self=shift; |
61 |
< |
|
62 |
< |
$self->newparse("init"); |
63 |
< |
$self->newparse("download"); |
64 |
< |
$self->newparse("setup"); |
65 |
< |
$self->newparse("setup_tools"); |
66 |
< |
$self->addarchtags("setup_tools"); |
67 |
< |
$self->addarchtags("setup"); |
68 |
< |
$self->addtag("init","project",\&Project_Start,$self, |
69 |
< |
\&Project_text,$self,"", $self ); |
70 |
< |
$self->addurltags("download"); |
71 |
< |
$self->addtag("download","download",\&Download_Start,$self, |
72 |
< |
"", $self, "",$self); |
73 |
< |
$self->addtag("download","use",\&Use_download_Start,$self, |
74 |
< |
"", $self, "",$self); |
75 |
< |
$self->addurltags("setup"); |
76 |
< |
$self->addtag("setup_tools","use",\&Use_Start,$self, "", $self, "",$self); |
77 |
< |
$self->addtag("setup","structure",\&Structure_Start,$self, |
78 |
< |
"", $self, "",$self); |
79 |
< |
|
80 |
< |
# data init |
81 |
< |
$self->{admindir}=".SCRAM"; |
82 |
< |
} |
83 |
< |
|
84 |
< |
sub basearea { |
85 |
< |
my $self=shift; |
86 |
< |
|
87 |
< |
my $area; |
88 |
< |
if ( @_ ) { |
89 |
< |
$area=shift; |
90 |
< |
$self->config()->store($area,"BaseArea"); |
91 |
< |
} |
92 |
< |
else { |
93 |
< |
($area)=$self->config()->restore("BaseArea"); |
94 |
< |
} |
95 |
< |
return $area; |
96 |
< |
} |
6 |
> |
@ISA=qw(Utilities::Verbose); |
7 |
|
|
8 |
< |
sub freebase { |
9 |
< |
my $self=shift; |
10 |
< |
$self->config()->delete("BaseArea"); |
8 |
> |
sub new { |
9 |
> |
my $class=shift; |
10 |
> |
my $self={}; |
11 |
> |
bless $self, $class; |
12 |
> |
$self->{admindir}=".SCRAM"; |
13 |
> |
$self->{configurationdir} = "config"; |
14 |
> |
$self->archname($ENV{SCRAM_ARCH}); |
15 |
> |
return $self; |
16 |
> |
} |
17 |
> |
|
18 |
> |
sub toolcachename |
19 |
> |
{ |
20 |
> |
my $self=shift; |
21 |
> |
return ($self->archdir()."/ToolCache.db.gz"); |
22 |
> |
} |
23 |
> |
|
24 |
> |
sub projectcachename |
25 |
> |
{ |
26 |
> |
my $self=shift; |
27 |
> |
return ($self->archdir()."/ProjectCache.db.gz"); |
28 |
> |
} |
29 |
> |
|
30 |
> |
sub symlinks { |
31 |
> |
my $self=shift; |
32 |
> |
if (@_) {$self->{symlinks}=shift;} |
33 |
> |
return $self->{symlinks}; |
34 |
> |
} |
35 |
> |
|
36 |
> |
sub calchksum { |
37 |
> |
my $self=shift; |
38 |
> |
my $dir=$self->location()."/".$self->configurationdir(); |
39 |
> |
push @INC,$dir; |
40 |
> |
require SCRAM::Plugins::ProjectChkSum; |
41 |
> |
my $sum=&SCRAM::Plugins::ProjectChkSum::chksum($dir); |
42 |
> |
pop @INC; |
43 |
> |
return $sum; |
44 |
|
} |
45 |
|
|
46 |
< |
sub defaultdirname { |
46 |
> |
sub configchksum { |
47 |
|
my $self=shift; |
48 |
< |
my $name=$self->name(); |
49 |
< |
my $vers=$self->version(); |
107 |
< |
$vers=~s/^$name\_//; |
108 |
< |
$name=$name."_".$vers; |
109 |
< |
return $name; |
48 |
> |
if (@_) {$self->{configchksum}=shift;} |
49 |
> |
return $self->{configchksum}; |
50 |
|
} |
51 |
|
|
52 |
|
|
53 |
< |
sub setup { |
114 |
< |
my $self=shift; |
115 |
< |
|
116 |
< |
# --- find out the location - default is cwd |
117 |
< |
my $location=$self->option("ConfigArea_location"); |
118 |
< |
if ( ! defined $location ) { |
119 |
< |
$location=cwd(); |
120 |
< |
} |
121 |
< |
elsif ( $location!~/^\// ) { |
122 |
< |
$location=cwd()."/".$location; |
123 |
< |
} |
124 |
< |
|
125 |
< |
# --- find area directory name , default name projectname_version |
126 |
< |
my $name=$self->option("ConfigArea_name"); |
127 |
< |
if ( ! defined $name ) { |
128 |
< |
$name=$self->defaultdirname(); |
129 |
< |
} |
130 |
< |
$self->location($location."/".$name); |
131 |
< |
|
132 |
< |
# make a new store handler |
133 |
< |
$self->_setupstore(); |
134 |
< |
|
135 |
< |
# --- download everything first |
136 |
< |
$self->parse("download"); |
137 |
< |
|
138 |
< |
# --- and parse the setup file |
139 |
< |
$self->parse("setup"); |
140 |
< |
$self->parse("setup_tools"); |
141 |
< |
|
142 |
< |
# --- store bootstrap info |
143 |
< |
$self->store($self->location()."/".$self->{admindir}."/ConfigArea.dat"); |
144 |
< |
|
145 |
< |
# --- store self in original database |
146 |
< |
$self->parentconfig()->store($self,"ConfigArea",$self->name(), |
147 |
< |
$self->version()); |
148 |
< |
} |
149 |
< |
|
150 |
< |
sub structure { |
53 |
> |
sub name { |
54 |
|
my $self=shift; |
55 |
< |
my $vr=shift; |
56 |
< |
return $self->{structures}{$vr}; |
55 |
> |
@_?$self->{name}=shift |
56 |
> |
:$self->{name}; |
57 |
|
} |
58 |
|
|
59 |
< |
sub structurelist { |
59 |
> |
sub version { |
60 |
|
my $self=shift; |
61 |
< |
return ( keys %{$self->{structures}} ); |
61 |
> |
@_?$self->{version}=shift |
62 |
> |
:$self->{version}; |
63 |
|
} |
64 |
|
|
65 |
< |
sub _setupstore { |
65 |
> |
sub setup { |
66 |
|
my $self=shift; |
67 |
< |
|
68 |
< |
# --- make a new ConfigStore at the location and add it to the db list |
69 |
< |
my $ad=Configuration::ConfigStore->new($self->location(). |
70 |
< |
"/".$self->{admindir}, $self->arch()); |
71 |
< |
|
72 |
< |
$self->parentconfig($self->config()); |
73 |
< |
# $self->config(Configuration::ConfigureStore->new()); |
74 |
< |
# $self->config()->db("local",$ad); |
75 |
< |
# $self->config()->db("parent",$self->parentconfig()); |
76 |
< |
# $self->config()->policy("cache","local"); |
77 |
< |
$self->config($ad); |
78 |
< |
$self->config()->basedoc($self->parentconfig()->basedoc()); |
67 |
> |
my $location=shift; |
68 |
> |
my $areaname=shift || undef; |
69 |
> |
my $symlinks=shift || 0; |
70 |
> |
my $locarea = shift || undef; |
71 |
> |
if ( (! defined $areaname) || ( $areaname eq "" ) ) { |
72 |
> |
$areaname=$self->version(); |
73 |
> |
} |
74 |
> |
$self->location($location."/".$areaname); |
75 |
> |
$self->symlinks($symlinks); |
76 |
> |
if ($self->configchksum() ne "") |
77 |
> |
{ |
78 |
> |
if ((!-defined $locarea) && (-f "${location}/${areaname}/".$self->admindir()."/Environment")) |
79 |
> |
{ |
80 |
> |
$locarea=Configuration::ConfigArea->new(); |
81 |
> |
$locarea->bootstrapfromlocation("${location}/${areaname}"); |
82 |
> |
} |
83 |
> |
if ((defined $locarea) && ($locarea->configchksum() != $self->configchksum())) |
84 |
> |
{ |
85 |
> |
print "ERROR: Can not setup your current working area for SCRAM_ARCH:$ENV{SCRAM_ARCH}.\n", |
86 |
> |
"Your current development area ${location}/${areaname}\n", |
87 |
> |
"is using a different ${areaname}/config then the one used for\n", |
88 |
> |
$self->releasetop(),".\n"; |
89 |
> |
exit 1; |
90 |
> |
} |
91 |
> |
} |
92 |
> |
Utilities::AddDir::adddir($self->archdir()); |
93 |
|
} |
94 |
|
|
95 |
< |
sub bootstrapfromlocation { |
95 |
> |
sub configurationdir { |
96 |
|
my $self=shift; |
97 |
< |
|
98 |
< |
if ( ! defined $self->location(@_) ) { |
181 |
< |
$self->error("Unable to locate the top of local configuration area"); |
97 |
> |
if ( @_ ) { |
98 |
> |
$self->{configurationdir}=shift; |
99 |
|
} |
100 |
< |
print "Found top ".$self->location()."\n"; |
184 |
< |
$self->_setupstore(); |
185 |
< |
$self->restore($self->location()."/".$self->{admindir}. |
186 |
< |
"/ConfigArea.dat"); |
100 |
> |
return (defined $self->{configurationdir})?$self->{configurationdir}:undef; |
101 |
|
} |
102 |
|
|
103 |
< |
sub parentconfig { |
103 |
> |
sub sourcedir { |
104 |
|
my $self=shift; |
105 |
< |
@_?$self->{parentconfig}=shift |
106 |
< |
:$self->{parentconfig}; |
105 |
> |
if ( @_ ) { |
106 |
> |
$self->{sourcedir}=shift; |
107 |
> |
} |
108 |
> |
return (defined $self->{sourcedir})?$self->{sourcedir}:undef; |
109 |
|
} |
110 |
|
|
111 |
< |
sub store { |
111 |
> |
sub releasetop { |
112 |
|
my $self=shift; |
113 |
< |
my $location=shift; |
114 |
< |
|
115 |
< |
my $fh=$self->openfile(">".$location); |
116 |
< |
$self->savevar($fh,"location", $self->location()); |
201 |
< |
$self->savevar($fh,"url", $self->url()); |
202 |
< |
$self->savevar($fh,"name", $self->name()); |
203 |
< |
$self->savevar($fh,"version", $self->version()); |
204 |
< |
$fh->close(); |
205 |
< |
|
206 |
< |
$self->_storestructures(); |
113 |
> |
if ( @_ ) { |
114 |
> |
$self->{releasetop}=shift; |
115 |
> |
} |
116 |
> |
return (defined $self->{releasetop})?$self->{releasetop}:undef; |
117 |
|
} |
118 |
|
|
119 |
< |
sub satellite { |
120 |
< |
my $self=shift; |
121 |
< |
my $newarea=$self->copy(@_); |
122 |
< |
$newarea->_makesatellites(); |
123 |
< |
return $newarea; |
124 |
< |
} |
119 |
> |
sub admindir() |
120 |
> |
{ |
121 |
> |
my $self=shift; |
122 |
> |
|
123 |
> |
@_ ? $self->{admindir} = shift |
124 |
> |
: $self->{admindir}; |
125 |
> |
} |
126 |
|
|
127 |
< |
sub copy { |
127 |
> |
sub bootstrapfromlocation { |
128 |
|
my $self=shift; |
129 |
< |
use File::Basename; |
130 |
< |
# create the area |
131 |
< |
|
132 |
< |
my $destination; |
222 |
< |
if ( @_ ) { |
223 |
< |
$destination=shift; |
129 |
> |
my $location = $self->searchlocation(shift); |
130 |
> |
my $rv=0; |
131 |
> |
if ( ! defined $location) { |
132 |
> |
$rv=1; |
133 |
|
} |
134 |
|
else { |
135 |
< |
my($location,$name)=$self->_defaultoptions(); |
136 |
< |
$destination=$location."/".$name |
135 |
> |
$self->location($location); |
136 |
> |
$self->_LoadEnvFile(); |
137 |
|
} |
138 |
< |
#AddDir::adddir(dirname($destination)."/".$self->{admindir}); |
230 |
< |
#AddDir::adddir($destination."/".$self->{admindir}); |
231 |
< |
|
232 |
< |
# copy across the admin dir |
233 |
< |
$temp=$self->location()."/".$self->{admindir}; |
234 |
< |
AddDir::copydir($temp,"$destination/".$self->{admindir}); |
235 |
< |
# create a new object based on the new area |
236 |
< |
my $newarea=ref($self)->new($self->parentconfig()); |
237 |
< |
$newarea->bootstrapfromlocation($destination); |
238 |
< |
# save it with the new location info |
239 |
< |
$newarea->store($self->location()."/".$self->{admindir}. |
240 |
< |
"/ConfigArea.dat"); |
241 |
< |
return $newarea; |
242 |
< |
} |
243 |
< |
|
244 |
< |
sub restore { |
245 |
< |
my $self=shift; |
246 |
< |
my $location=shift; |
247 |
< |
|
248 |
< |
my $fh=$self->openfile("<".$location); |
249 |
< |
my $varhash={}; |
250 |
< |
$self->restorevars($fh,$varhash); |
251 |
< |
if ( ! defined $self->location() ) { |
252 |
< |
$self->location($$varhash{"location"}); |
253 |
< |
} |
254 |
< |
$self->_setupstore(); |
255 |
< |
$self->url($$varhash{"url"}); |
256 |
< |
$self->name($$varhash{"name"}); |
257 |
< |
$self->version($$varhash{"version"}); |
258 |
< |
$fh->close(); |
259 |
< |
|
260 |
< |
$self->_restorestructures(); |
261 |
< |
} |
262 |
< |
|
263 |
< |
sub name { |
264 |
< |
my $self=shift; |
265 |
< |
|
266 |
< |
@_?$self->{name}=shift |
267 |
< |
:$self->{name}; |
268 |
< |
} |
269 |
< |
|
270 |
< |
sub version { |
271 |
< |
my $self=shift; |
272 |
< |
|
273 |
< |
@_?$self->{version}=shift |
274 |
< |
:$self->{version}; |
138 |
> |
return $rv; |
139 |
|
} |
140 |
|
|
141 |
|
sub location { |
143 |
|
|
144 |
|
if ( @_ ) { |
145 |
|
$self->{location}=shift; |
146 |
+ |
$self->archname($ENV{SCRAM_ARCH}); |
147 |
|
} |
148 |
|
elsif ( ! defined $self->{location} ) { |
149 |
|
# try and find the release location |
150 |
|
$self->{location}=$self->searchlocation(); |
151 |
+ |
if (defined $self->{location}) |
152 |
+ |
{ |
153 |
+ |
$self->archname($ENV{SCRAM_ARCH}); |
154 |
+ |
} |
155 |
|
} |
156 |
|
return $self->{location}; |
157 |
|
} |
158 |
|
|
159 |
|
sub searchlocation { |
160 |
|
my $self=shift; |
161 |
< |
|
161 |
> |
|
162 |
|
#start search in current directory if not specified |
163 |
|
my $thispath; |
164 |
< |
@_?$thispath=shift |
165 |
< |
:$thispath=cwd(); |
166 |
< |
|
164 |
> |
if ( @_ ) { |
165 |
> |
$thispath=shift |
166 |
> |
} |
167 |
> |
else { |
168 |
> |
$thispath=cwd(); |
169 |
> |
} |
170 |
> |
|
171 |
|
my $rv=0; |
172 |
|
|
173 |
+ |
# chop off any files - we only want dirs |
174 |
+ |
if ( -f $thispath ) { |
175 |
+ |
$thispath=~s/(.*)\/.*/$1/; |
176 |
+ |
} |
177 |
|
Sloop:{ |
178 |
|
do { |
179 |
< |
# print "Searching $thispath\n"; |
179 |
> |
$self->verbose("Searching $thispath"); |
180 |
|
if ( -e "$thispath/".$self->{admindir} ) { |
181 |
< |
# print "Found\n"; |
181 |
> |
$self->verbose("Found\n"); |
182 |
|
$rv=1; |
183 |
|
last Sloop; |
184 |
|
} |
185 |
|
} while ( ($thispath=~s/(.*)\/.*/$1/)=~/./ ) }; |
186 |
< |
|
186 |
> |
|
187 |
|
return $rv?$thispath:undef; |
188 |
|
} |
189 |
|
|
190 |
< |
sub meta { |
190 |
> |
sub archname { |
191 |
|
my $self=shift; |
192 |
< |
|
193 |
< |
my $string=$self->name()." ".$self->version()." located at :\n ". |
194 |
< |
$self->location; |
195 |
< |
} |
319 |
< |
|
320 |
< |
sub configitem { |
321 |
< |
my $self=shift; |
322 |
< |
|
323 |
< |
return ($self->config()->find("ConfigItem",@_)); |
324 |
< |
} |
325 |
< |
|
326 |
< |
sub addconfigitem { |
327 |
< |
my $self=shift; |
328 |
< |
my $url=shift; |
329 |
< |
|
330 |
< |
my $docref=$self->activatedoc($url); |
331 |
< |
# Set up the document |
332 |
< |
$docref->setup(); |
333 |
< |
$docref->save(); |
334 |
< |
# $self->config()->storepolicy("local"); |
335 |
< |
} |
336 |
< |
|
337 |
< |
sub downloadtotop { |
338 |
< |
my $self=shift; |
339 |
< |
my $url=shift; |
340 |
< |
my $dir=shift; |
341 |
< |
|
342 |
< |
# only download once |
343 |
< |
if ( ! -e $self->location()."/".$dir ) { |
344 |
< |
$self->{urlhandler}->download($url,$self->location()."/".$dir); |
345 |
< |
} |
346 |
< |
} |
347 |
< |
|
348 |
< |
sub _makesatellites { |
349 |
< |
my $self=shift; |
350 |
< |
foreach $st ( values %{$self->{structures}} ) { |
351 |
< |
$st->setupsatellite() |
192 |
> |
if ( @_ ) { |
193 |
> |
if (defined $self->{location}) { |
194 |
> |
$self->archdir($self->{location}."/".$self->{admindir}."/".$ENV{SCRAM_ARCH}); |
195 |
> |
} |
196 |
|
} |
197 |
+ |
return $ENV{SCRAM_ARCH}; |
198 |
|
} |
199 |
|
|
200 |
< |
sub _storestructures { |
200 |
> |
sub archdir { |
201 |
|
my $self=shift; |
202 |
< |
foreach $struct ( values %{$self->{structures}} ) { |
203 |
< |
$self->config()->store($struct, "Structures", $struct->name()); |
202 |
> |
if ( @_ ) { |
203 |
> |
$self->{archdir}=shift; |
204 |
|
} |
205 |
+ |
return $self->{archdir}; |
206 |
|
} |
207 |
|
|
208 |
< |
sub _restorestructures { |
208 |
> |
sub satellite { |
209 |
|
my $self=shift; |
210 |
< |
my @strs=$self->config()->find("Structures"); |
211 |
< |
foreach $struct ( @strs ) { |
212 |
< |
$struct->parent($self); |
213 |
< |
$self->{structures}{$struct->name()}=$struct; |
214 |
< |
} |
210 |
> |
my $relloc = $self->location(); |
211 |
> |
my $sat=Configuration::ConfigArea->new(); |
212 |
> |
$sat->name($self->name()); |
213 |
> |
$sat->version($self->version()); |
214 |
> |
$sat->configurationdir($self->configurationdir()); |
215 |
> |
$sat->sourcedir($self->sourcedir()); |
216 |
> |
$sat->releasetop($relloc); |
217 |
> |
$sat->configchksum($self->configchksum()); |
218 |
> |
$sat->setup(@_); |
219 |
> |
$self->copywithskip($self->archdir(),$sat->archdir(),["InstalledTools","ProjectCache.db.gz","RuntimeCache.db.gz","DirCache.db.gz","MakeData/DirCache","MakeData/DirCache.mk","MakeData/src.mk"]); |
220 |
> |
$envfile = $sat->archdir()."/Environment"; |
221 |
> |
open ( $fh, "> $envfile" ) or $sat->error("Cannot Open \"$envfile\" file to Save\n $!"); |
222 |
> |
print $fh "RELEASETOP=$relloc\n"; |
223 |
> |
close($fh); |
224 |
> |
my $devconf = $sat->location()."/".$sat->configurationdir(); |
225 |
> |
my $relconf = $self->location()."/".$self->configurationdir(); |
226 |
> |
if (!-d $devconf) |
227 |
> |
{ |
228 |
> |
$self->copywithskip($relconf,$devconf,['toolbox']); |
229 |
> |
} |
230 |
> |
$envfile = $sat->location()."/".$self->{admindir}."/Environment"; |
231 |
> |
if (! -f $envfile) |
232 |
> |
{ |
233 |
> |
$sat->save (); |
234 |
> |
} |
235 |
> |
Utilities::AddDir::copydir("${relconf}/toolbox/$ENV{SCRAM_ARCH}","${devconf}/toolbox/$ENV{SCRAM_ARCH}"); |
236 |
> |
Utilities::AddDir::adddir ($sat->location()."/".$sat->sourcedir()); |
237 |
> |
return $sat; |
238 |
> |
} |
239 |
> |
|
240 |
> |
sub copywithskip { |
241 |
> |
my $self=shift; |
242 |
> |
my $src=shift; |
243 |
> |
my $des=shift; |
244 |
> |
my $filetoskip=shift || []; |
245 |
> |
my $rv=1; |
246 |
> |
if ( $src ne $des ) |
247 |
> |
{ |
248 |
> |
if ( -d $src ) |
249 |
> |
{ |
250 |
> |
my $fs=[]; |
251 |
> |
foreach my $f (@$filetoskip) {push @$fs,"${src}/${f}";} |
252 |
> |
Utilities::AddDir::copydirwithskip($src,$des,$fs); |
253 |
> |
$rv=0; |
254 |
> |
} |
255 |
> |
} |
256 |
> |
return $rv; |
257 |
|
} |
258 |
|
|
259 |
< |
sub _defaultoptions { |
259 |
> |
sub copyenv { |
260 |
|
my $self=shift; |
373 |
– |
my $name; |
374 |
– |
my $location; |
375 |
– |
|
376 |
– |
# --- find out the location - default is cwd |
377 |
– |
$location=$self->option("ConfigArea_location"); |
378 |
– |
if ( ! defined $location ) { |
379 |
– |
$location=cwd(); |
380 |
– |
} |
381 |
– |
elsif ( $location!~/^\// ) { |
382 |
– |
$location=cwd()."/".$location; |
383 |
– |
} |
384 |
– |
|
385 |
– |
# --- find area directory name , default name projectname_version |
386 |
– |
$name=$self->option("ConfigArea_name"); |
387 |
– |
if ( ! defined $name ) { |
388 |
– |
$name=$self->defaultdirname(); |
389 |
– |
} |
390 |
– |
return ($location,$name); |
391 |
– |
} |
392 |
– |
# -------------- Tags --------------------------------- |
393 |
– |
# -- init parse |
394 |
– |
sub Project_Start { |
395 |
– |
my $self=shift; |
396 |
– |
my $name=shift; |
261 |
|
my $hashref=shift; |
262 |
< |
|
263 |
< |
$self->checktag($name,$hashref,'name'); |
264 |
< |
$self->checktag($name,$hashref,'version'); |
401 |
< |
|
402 |
< |
$self->name($$hashref{'name'}); |
403 |
< |
$self->version($$hashref{'version'}); |
404 |
< |
} |
405 |
< |
|
406 |
< |
|
407 |
< |
sub Project_text { |
408 |
< |
my $self=shift; |
409 |
< |
my $name=shift; |
410 |
< |
my $string=shift; |
411 |
< |
|
412 |
< |
print $string; |
413 |
< |
} |
414 |
< |
|
415 |
< |
# ---- download parse |
416 |
< |
|
417 |
< |
sub Download_Start { |
418 |
< |
my $self=shift; |
419 |
< |
my $name=shift; |
420 |
< |
my $hashref=shift; |
421 |
< |
|
422 |
< |
$self->checktag($name,$hashref,'url'); |
423 |
< |
$self->checktag($name,$hashref,'location'); |
424 |
< |
if ( $$hashref{'location'}!~/^\w/ ) { |
425 |
< |
$self->parseerror("location must start with an". |
426 |
< |
" alphanumeric character"); |
262 |
> |
|
263 |
> |
foreach $elem ( keys %{$self->{ENV}} ) { |
264 |
> |
$$hashref{$elem}=$self->{ENV}{$elem}; |
265 |
|
} |
428 |
– |
print "Downloading .... ".$$hashref{'url'}."\n"; |
429 |
– |
$self->downloadtotop($$hashref{'url'},$$hashref{'location'}); |
266 |
|
} |
267 |
|
|
268 |
< |
sub Use_download_Start { |
268 |
> |
sub arch { |
269 |
|
my $self=shift; |
270 |
< |
my $name=shift; |
435 |
< |
my $hashref=shift; |
436 |
< |
|
437 |
< |
$self->checktag($name,$hashref,'url'); |
438 |
< |
print "Downloading .... ".$$hashref{'url'}."\n"; |
439 |
< |
$self->getfile($$hashref{'url'}); |
270 |
> |
return $ENV{SCRAM_ARCH}; |
271 |
|
} |
272 |
|
|
273 |
< |
# --- setup parse |
443 |
< |
|
444 |
< |
sub Structure_Start { |
273 |
> |
sub save { |
274 |
|
my $self=shift; |
275 |
< |
my $name=shift; |
447 |
< |
my $hashref=shift; |
448 |
< |
|
449 |
< |
$self->checktag($name,$hashref,'name'); |
450 |
< |
if ( !( exists $$hashref{'type'}) || ( exists $$hashref{'url'}) ) { |
451 |
< |
$self->parseerror("No url or type given in <$name> tag"); |
452 |
< |
} |
453 |
< |
if ( ! exists $self->{structures}{$$hashref{'name'}} ) { |
454 |
< |
if ( exists $$hashref{'type'}) { |
455 |
< |
# create a new object of the specified type |
456 |
< |
eval "require $$hashref{'type'} "; |
457 |
< |
if ( $@ ) { |
458 |
< |
$self->parseerror("Unable to instantiate type=". |
459 |
< |
$$hashref{'type'}." in <$name> .".$@); |
460 |
< |
} |
461 |
< |
$self->{structures}{$$hashref{'name'}}= |
462 |
< |
$$hashref{'type'}->new($self->config()); |
463 |
< |
$self->{structures}{$$hashref{'name'}}->name($$hashref{'name'}); |
464 |
< |
$self->{structures}{$$hashref{'name'}}->parent($self); |
465 |
< |
$self->{structures}{$$hashref{'name'}}->vars($hashref); |
466 |
< |
} |
467 |
< |
else { # its an activedoc |
468 |
< |
$self->{structures}{$$hashref{'name'}}= |
469 |
< |
$self->activatedoc($$hashref{'url'}); |
470 |
< |
} |
471 |
< |
$self->{structures}{$$hashref{'name'}}->setupbase(); |
472 |
< |
} |
473 |
< |
else { |
474 |
< |
$self->parseerror("Multiply defined Structure - ". |
475 |
< |
$$hashref{'name'}); |
476 |
< |
} |
275 |
> |
$self->_SaveEnvFile(); |
276 |
|
} |
277 |
|
|
278 |
< |
sub Use_Start { |
480 |
< |
my $self=shift; |
481 |
< |
my $name=shift; |
482 |
< |
my $hashref=shift; |
483 |
< |
|
484 |
< |
$self->checktag($name,$hashref,'url'); |
485 |
< |
$self->addconfigitem($$hashref{'url'}); |
486 |
< |
} |
278 |
> |
# ---- support routines |
279 |
|
|
280 |
+ |
sub _SaveEnvFile |
281 |
+ |
{ |
282 |
+ |
my $self=shift; |
283 |
+ |
|
284 |
+ |
my $fh; |
285 |
+ |
my $envfile = $self->location()."/".$self->{admindir}."/Environment"; |
286 |
+ |
open ( $fh, "> $envfile" ) or $self->error("Cannot Open \"$envfile\" file to Save\n $!"); |
287 |
+ |
|
288 |
+ |
print $fh "SCRAM_PROJECTNAME=".$self->name()."\n"; |
289 |
+ |
print $fh "SCRAM_PROJECTVERSION=".$self->version()."\n"; |
290 |
+ |
print $fh "SCRAM_CONFIGDIR=".$self->configurationdir()."\n"; |
291 |
+ |
print $fh "SCRAM_SOURCEDIR=".$self->sourcedir()."\n"; |
292 |
+ |
print $fh "SCRAM_SYMLINKS=",$self->symlinks(),"\n"; |
293 |
+ |
print $fh "SCRAM_CONFIGCHKSUM=",$self->configchksum(),"\n"; |
294 |
+ |
close($fh); |
295 |
+ |
|
296 |
+ |
# Set the default permissions (-rw-r--r--): |
297 |
+ |
my $filemode = 0644; |
298 |
+ |
chmod $filemode, $self->location()."/".$self->{admindir}."/Environment"; |
299 |
+ |
} |
300 |
+ |
|
301 |
+ |
sub _LoadEnvFile |
302 |
+ |
{ |
303 |
+ |
my $self=shift; |
304 |
+ |
|
305 |
+ |
my $fh; |
306 |
+ |
my $envfile = $self->location()."/".$self->{admindir}."/Environment"; |
307 |
+ |
open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!"); |
308 |
+ |
while ( <$fh> ) |
309 |
+ |
{ |
310 |
+ |
chomp; |
311 |
+ |
next if /^#/; |
312 |
+ |
next if /^\s*$/ ; |
313 |
+ |
($name, $value)=split /=/; |
314 |
+ |
eval "\$self->{ENV}{${name}}=\"$value\""; |
315 |
+ |
} |
316 |
+ |
close($fh); |
317 |
+ |
$envfile = $self->archdir()."/Environment"; |
318 |
+ |
if (-f $envfile) |
319 |
+ |
{ |
320 |
+ |
open ( $fh, "< $envfile" ) or $self->error("Cannot open \"$envfile\" file for reading.\n $!"); |
321 |
+ |
while ( <$fh> ) |
322 |
+ |
{ |
323 |
+ |
chomp; |
324 |
+ |
next if /^#/; |
325 |
+ |
next if /^\s*$/ ; |
326 |
+ |
($name, $value)=split /=/; |
327 |
+ |
eval "\$self->{ENV}{${name}}=\"$value\""; |
328 |
+ |
} |
329 |
+ |
close($fh); |
330 |
+ |
} |
331 |
+ |
|
332 |
+ |
# -- set internal variables appropriately |
333 |
+ |
if ( defined $self->{ENV}{"SCRAM_PROJECTNAME"} ) |
334 |
+ |
{ |
335 |
+ |
$self->name($self->{ENV}{"SCRAM_PROJECTNAME"}); |
336 |
+ |
} |
337 |
+ |
if ( defined $self->{ENV}{"SCRAM_SYMLINKS"} ) |
338 |
+ |
{ |
339 |
+ |
$self->symlinks($self->{ENV}{"SCRAM_SYMLINKS"}); |
340 |
+ |
} |
341 |
+ |
if ( defined $self->{ENV}{"SCRAM_CONFIGCHKSUM"} ) |
342 |
+ |
{ |
343 |
+ |
$self->configchksum($self->{ENV}{"SCRAM_CONFIGCHKSUM"}); |
344 |
+ |
} |
345 |
+ |
if ( defined $self->{ENV}{"SCRAM_PROJECTVERSION"} ) |
346 |
+ |
{ |
347 |
+ |
$self->version($self->{ENV}{"SCRAM_PROJECTVERSION"}); |
348 |
+ |
} |
349 |
+ |
if ( defined $self->{ENV}{"SCRAM_CONFIGDIR"} ) |
350 |
+ |
{ |
351 |
+ |
$self->configurationdir($self->{ENV}{"SCRAM_CONFIGDIR"}); |
352 |
+ |
} |
353 |
+ |
if ( defined $self->{ENV}{"SCRAM_SOURCEDIR"} ) |
354 |
+ |
{ |
355 |
+ |
$self->sourcedir($self->{ENV}{"SCRAM_SOURCEDIR"}); |
356 |
+ |
} |
357 |
+ |
if ( defined $self->{ENV}{"RELEASETOP"} ) |
358 |
+ |
{ |
359 |
+ |
$self->releasetop($self->{ENV}{"RELEASETOP"}); |
360 |
+ |
} |
361 |
+ |
} |
362 |
+ |
1; |