| 4 |
|
# |
| 5 |
|
# Author: Shaun Ashby <Shaun.Ashby@cern.ch> |
| 6 |
|
# (with contribution from Lassi.Tuura@cern.ch) |
| 7 |
– |
# Update: 2003-11-27 16:45:18+0100 |
| 8 |
– |
# Revision: $Id$ |
| 9 |
– |
# |
| 7 |
|
# Copyright: 2003 (C) Shaun Ashby |
| 8 |
|
# |
| 9 |
|
#-------------------------------------------------------------------- |
| 38 |
|
|
| 39 |
|
=item C<new()> |
| 40 |
|
|
| 41 |
< |
Create a new Cache::Cache object. The name of the cache is B<DirCache.db> by default. |
| 41 |
> |
Create a new Cache::Cache object. The name of the cache is B<DirCache.db.gz> by default. |
| 42 |
|
|
| 43 |
|
=cut |
| 44 |
|
|
| 57 |
|
my $class=ref($proto) || $proto; |
| 58 |
|
my $self= |
| 59 |
|
{ |
| 60 |
< |
CACHENAME => "DirCache.db", # Name of global file/dir cache; |
| 60 |
> |
CACHENAME => "DirCache.db.gz", # Name of global file/dir cache; |
| 61 |
|
BFCACHE => {}, # BuildFile cache; |
| 62 |
|
DIRCACHE => {}, # Source code cache; |
| 63 |
|
EXTRASUFFIX => {}, # path with extra suffix; |
| 79 |
|
{ |
| 80 |
|
my $self=shift; |
| 81 |
|
my $path=shift; |
| 82 |
+ |
my $ignore=shift || 'CVS|\\..*'; |
| 83 |
+ |
my $match=shift || ".+"; |
| 84 |
|
|
| 85 |
|
opendir (DIR, $path) || die "$path: cannot read: $!\n"; |
| 86 |
|
# Skip .admin and CVS subdirectories too. |
| 87 |
|
# Also skip files that look like backup files or files being modified with emacs: |
| 88 |
< |
my @items = map { "$path/$_" } grep ((-d "$path/$_") && ($_!~/^(CVS|\..*)$/),readdir(DIR)); |
| 88 |
> |
my @items = map { "$path/$_" } grep ((-d "$path/$_") && ($_=~/^($match)$/) && ($_!~/^($ignore)$/),readdir(DIR)); |
| 89 |
|
closedir (DIR); |
| 90 |
|
return @items; |
| 91 |
|
} |
| 167 |
|
# Otherwise use the cache as the list of items we need to change. |
| 168 |
|
my $cached = $self->{DIRCACHE}{$path}; |
| 169 |
|
my @items = (); |
| 170 |
+ |
my $matchdir='[a-zA-Z0-9][a-zA-Z0-9-_]*'; |
| 171 |
|
|
| 172 |
|
if (! -d _) |
| 173 |
|
{ |
| 178 |
|
{ |
| 179 |
|
# When a directory is added, this block is activated |
| 180 |
|
$self->{ADDEDDIR}{$path}=1; |
| 181 |
< |
$self->{DIRCACHE}{$path} = [ (stat(_))[9], @items = $self->getdir($path) ]; |
| 181 |
> |
$self->{DIRCACHE}{$path} = [ (stat(_))[9], @items = $self->getdir($path,'',$matchdir) ]; |
| 182 |
|
$required = 1; |
| 183 |
|
$self->cachestatus(1); |
| 184 |
|
} |
| 191 |
|
# update can be taken recursively from this dir: |
| 192 |
|
#$self->modified_parentdirs($path); |
| 193 |
|
# Current subdirs: |
| 194 |
< |
my %curdirs = map { $_ => 1 } $self->getdir($path); |
| 194 |
> |
my %curdirs = map { $_ => 1 } $self->getdir($path,'',$matchdir); |
| 195 |
|
my %olddirs = (); |
| 196 |
|
for (my $i = 1; $i <= $#$cached; $i++) |
| 197 |
|
{ |
| 232 |
|
} |
| 233 |
|
|
| 234 |
|
my $bfcachedir=$ENV{LOCALTOP}."/".$ENV{SCRAM_TMP}."/".$ENV{SCRAM_ARCH}."/cache/bf/${path}"; |
| 235 |
+ |
my $cbf="${bfcachedir}/$ENV{SCRAM_BUILDFILE}"; |
| 236 |
|
my $bftime=0; |
| 237 |
|
my $bf="${path}/$ENV{SCRAM_BUILDFILE}"; |
| 237 |
– |
if (($self->{convertxml}) && (!-f "${bf}.xml") && (-f "$bf")) |
| 238 |
– |
{ |
| 239 |
– |
my $fref; |
| 240 |
– |
$self->{nonxml} = $self->{nonxml}+1; |
| 241 |
– |
if (open($fref,">${bf}.xml")) |
| 242 |
– |
{ |
| 243 |
– |
print ">> Converting $bf => ${bf}.xml\n"; |
| 244 |
– |
$self->{convertxml}->clean(); |
| 245 |
– |
my $xml=$self->{convertxml}->convert($bf); |
| 246 |
– |
foreach my $line (@$xml){print $fref "$line\n";} |
| 247 |
– |
close($fref); |
| 248 |
– |
$self->{convertxml}->clean(); |
| 249 |
– |
} |
| 250 |
– |
else |
| 251 |
– |
{ |
| 252 |
– |
print STDERR "**** WARNING: Can not open file for writing: ${bf}.xml\n"; |
| 253 |
– |
} |
| 254 |
– |
} |
| 238 |
|
foreach my $ext (".xml","") |
| 239 |
|
{ |
| 240 |
|
my $bfn="$bf$ext"; |
| 244 |
|
{ |
| 245 |
|
$self->{REMOVEDBF}{$bfn}=1; |
| 246 |
|
delete $self->{BFCACHE}{$bfn}; |
| 247 |
< |
AddDir::adddir($bfcachedir); |
| 248 |
< |
open(BF,">${bfcachedir}/$ENV{SCRAM_BUILDFILE}");close(BF); |
| 247 |
> |
Utilities::AddDir::adddir($bfcachedir); |
| 248 |
> |
open(BF,">${cbf}");close(BF); |
| 249 |
|
$self->cachestatus(1); |
| 250 |
|
} |
| 251 |
|
} |
| 255 |
|
if ((! exists $self->{BFCACHE}{$bfn}) || |
| 256 |
|
($bftime != $self->{BFCACHE}{$bfn})) |
| 257 |
|
{ |
| 258 |
< |
AddDir::adddir($bfcachedir); |
| 259 |
< |
open(BF,">${bfcachedir}/$ENV{SCRAM_BUILDFILE}");close(BF); |
| 260 |
< |
$self->{ADDEDBF}{$bfn}=1; |
| 261 |
< |
delete $self->{BFCACHE}{"${path}/$ENV{SCRAM_BUILDFILE}"}; |
| 258 |
> |
if ((!-f "${cbf}") || (exists $self->{BFCACHE}{$bfn})) |
| 259 |
> |
{ |
| 260 |
> |
Utilities::AddDir::adddir($bfcachedir); |
| 261 |
> |
open(BF,">${cbf}");close(BF); |
| 262 |
> |
} |
| 263 |
> |
$self->{ADDEDBF}{$bfn}=1; |
| 264 |
> |
delete $self->{BFCACHE}{$bf}; |
| 265 |
|
$self->{BFCACHE}{$bfn}=$bftime; |
| 266 |
|
if ($ext eq ""){$self->{nonxml}+=1;} |
| 267 |
|
$self->cachestatus(1); |
| 270 |
|
{ |
| 271 |
|
$self->{ADDEDBF}{$bfn}=1; |
| 272 |
|
if ($ext eq ""){$self->{nonxml}+=1;} |
| 273 |
< |
if (!-f "${bfcachedir}/$ENV{SCRAM_BUILDFILE}") |
| 273 |
> |
if (!-f "${cbf}") |
| 274 |
|
{ |
| 275 |
< |
AddDir::adddir($bfcachedir); |
| 276 |
< |
open(BF,">${bfcachedir}/$ENV{SCRAM_BUILDFILE}");close(BF); |
| 275 |
> |
Utilities::AddDir::adddir($bfcachedir); |
| 276 |
> |
open(BF,">${cbf}");close(BF); |
| 277 |
|
} |
| 278 |
|
$self->cachestatus(1); |
| 279 |
|
} |
| 280 |
|
last; |
| 281 |
|
} |
| 282 |
|
} |
| 283 |
+ |
if (exists $self->{ExtraDirCache}) |
| 284 |
+ |
{ |
| 285 |
+ |
eval {$self->{ExtraDirCache}->DirCache($self,$path);}; |
| 286 |
+ |
} |
| 287 |
|
# Process sub-directories |
| 288 |
|
foreach my $item (@items) |
| 289 |
|
{ |
| 342 |
|
{ |
| 343 |
|
my $self=shift; |
| 344 |
|
$self->{cachereset}=shift || 0; |
| 355 |
– |
$self->{convertxml}=shift || 0; |
| 345 |
|
# Scan config dir for top-level data, then start from src: |
| 346 |
|
my @scandirs=($ENV{SCRAM_CONFIGDIR}, $ENV{SCRAM_SOURCEDIR}); |
| 347 |
|
# Loop over all directories that need scanning (normally just src and config): |
| 359 |
– |
if ($self->{convertxml}) |
| 360 |
– |
{ |
| 361 |
– |
eval ("use SCRAM::Doc2XML"); |
| 362 |
– |
if (!$@) |
| 363 |
– |
{ |
| 364 |
– |
$self->{convertxml} = SCRAM::Doc2XML->new(); |
| 365 |
– |
} |
| 366 |
– |
else |
| 367 |
– |
{ |
| 368 |
– |
print STDERR "**** WARNING: Can not convert $ENV{SCRAM_BUILDFILE} in to XML format. Missing SCRAM::Doc2XML perl module.\n"; |
| 369 |
– |
} |
| 370 |
– |
} |
| 348 |
|
$self->{nonxml}=0; |
| 349 |
+ |
eval ("use SCRAM::Plugins::DirCache;"); |
| 350 |
+ |
if(!$@) {$self->{ExtraDirCache} = SCRAM::Plugins::DirCache->new();} |
| 351 |
|
foreach my $scand (@scandirs) |
| 352 |
|
{ |
| 353 |
|
$self->logmsg("SCRAM: Scanning $scand [dofiles set to ".$dofiles."]\n"); |
| 365 |
|
} |
| 366 |
|
} |
| 367 |
|
} |
| 368 |
+ |
delete $self->{ExtraDirCache}; |
| 369 |
|
if ($self->{nonxml} > 0) |
| 370 |
|
{ |
| 371 |
< |
print STDERR "**** WARNING: ",$self->{nonxml}," non-xml based $ENV{SCRAM_BUILDFILE} were read.\n"; |
| 371 |
> |
#print STDERR "**** WARNING: ",$self->{nonxml}," non-xml based $ENV{SCRAM_BUILDFILE} were read.\n"; |
| 372 |
|
} |
| 373 |
|
return $self; |
| 374 |
|
} |
| 599 |
|
=item C<name()> |
| 600 |
|
|
| 601 |
|
Set or return the name of the cache. Normally set |
| 602 |
< |
to B<DirCache.db> (and not architecture dependent). |
| 602 |
> |
to B<DirCache.db.gz> (and not architecture dependent). |
| 603 |
|
|
| 604 |
|
=cut |
| 605 |
|
|
