1 |
williamc |
1.1 |
#
|
2 |
|
|
# Utility Routines for the SCRAM tools
|
3 |
|
|
#
|
4 |
williamc |
1.8 |
# Interface
|
5 |
|
|
#
|
6 |
|
|
# dated(testfile,@dependencies) : returns 1 if testfile is older than any of its
|
7 |
|
|
# dependencies or does not exist
|
8 |
williamc |
1.1 |
|
9 |
|
|
package SCRAMUtils;
|
10 |
williamc |
1.2 |
require 5.001;
|
11 |
williamc |
1.1 |
require Exporter;
|
12 |
|
|
@ISA = qw(Exporter);
|
13 |
williamc |
1.8 |
@EXPORT = qw(checkfile updatelookup dated);
|
14 |
williamc |
1.1 |
use Carp;
|
15 |
|
|
|
16 |
williamc |
1.8 |
sub dated {
|
17 |
|
|
my $testfile=shift;
|
18 |
|
|
my @files=@_;
|
19 |
|
|
|
20 |
|
|
my $rv=0;
|
21 |
|
|
if ( -f $testfile ) {
|
22 |
|
|
my $time=(stat($testfile))[9];
|
23 |
|
|
foreach $file ( @files ) {
|
24 |
|
|
if ( -f $file ) {
|
25 |
|
|
if ( (stat($file))[9] > $time ) {
|
26 |
|
|
$rv=1;
|
27 |
|
|
print "$testfile is out of date relative to $file\n";
|
28 |
|
|
}
|
29 |
|
|
}
|
30 |
|
|
}
|
31 |
|
|
}
|
32 |
|
|
else { $rv=1; }
|
33 |
|
|
return $rv;
|
34 |
|
|
}
|
35 |
|
|
|
36 |
williamc |
1.3 |
sub checkfile {
|
37 |
williamc |
1.1 |
my $filename=shift;
|
38 |
|
|
my $thisfile="";
|
39 |
williamc |
1.5 |
$thisfile=$ENV{LOCALTOP}."/".$filename;
|
40 |
williamc |
1.1 |
return $thisfile, if ( -e $thisfile );
|
41 |
williamc |
1.5 |
$thisfile=$ENV{RELEASETOP}."/".$filename;
|
42 |
williamc |
1.1 |
return $thisfile, if ( -e $thisfile );
|
43 |
|
|
return "";
|
44 |
|
|
}
|
45 |
|
|
|
46 |
|
|
#
|
47 |
|
|
# Replace or add an entry in a hashing file
|
48 |
|
|
#
|
49 |
|
|
sub updatelookup {
|
50 |
|
|
my $filename=shift;
|
51 |
|
|
my $key=shift;
|
52 |
|
|
my $rest=shift;
|
53 |
|
|
my $update=0;
|
54 |
|
|
use File::Copy;
|
55 |
|
|
|
56 |
|
|
open ( SCRAMWORK, ">$filename.wk" ) or
|
57 |
|
|
croak "Unable to open $filename.wk ".$!."\n";
|
58 |
|
|
open ( SCRAMUPDATEFILE, $filename );
|
59 |
williamc |
1.8 |
# print "Searching for ".$key."\n";
|
60 |
williamc |
1.1 |
while ( <SCRAMUPDATEFILE> ) {
|
61 |
williamc |
1.6 |
chomp;
|
62 |
|
|
if ( $_=~/^\Q$key\E/ ) {
|
63 |
williamc |
1.1 |
$update=1;
|
64 |
|
|
print SCRAMWORK $key.$rest."\n";
|
65 |
|
|
}
|
66 |
williamc |
1.4 |
else {
|
67 |
williamc |
1.6 |
print SCRAMWORK $_."\n";
|
68 |
williamc |
1.4 |
}
|
69 |
williamc |
1.1 |
}
|
70 |
|
|
close SCRAMUPDATEFILE;
|
71 |
|
|
if ( $update==0 ) {
|
72 |
|
|
print SCRAMWORK $key.$rest."\n";
|
73 |
|
|
}
|
74 |
|
|
close SCRAMWORK;
|
75 |
|
|
copy "$filename.wk", $filename or croak "Unable to update file "
|
76 |
|
|
."$filename $!\n";
|
77 |
|
|
|
78 |
|
|
}
|