src/Utilities/SCRAMUtils.pm

#
# Utility Routines for the SCRAM tools
#
# Interface
#
# dated(testfile,@dependencies) : returns 1 if testfile is older than any of its
#                                 dependencies or does not exist

package SCRAMUtils;
require 5.001;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(checkfile updatelookup dated);
use Carp;

sub dated {
        my $testfile=shift;
        my @files=@_;

        my $rv=0;
        if ( -f $testfile ) {
           my $time=(stat($testfile))[9];
           foreach $file ( @files ) {
            if ( -f $file ) {
             if ( (stat($file))[9] > $time ) {
                $rv=1;
                print "$testfile is out of date relative to $file\n";
             }
            }
           }
        }
        else { $rv=1; }
        return $rv;
}

sub checkfile {
        my $filename=shift;
        my $thisfile="";
        $thisfile=$ENV{LOCALTOP}."/".$filename;
        return $thisfile, if ( -e $thisfile );
        $thisfile=$ENV{RELEASETOP}."/".$filename;
        return $thisfile, if ( -e $thisfile );
        return "";
}

#
# Replace or add an entry in a hashing file
#
sub updatelookup {
        my $filename=shift;
        my $key=shift;
        my $rest=shift;
        my $update=0;
        use File::Copy;
        local $_;
        use FileHandle;
        my $fhw=FileHandle->new();
        my $fh=FileHandle->new();
        open ( $fhw, ">".$filename.".wk" )  ||
                die "Unable to open $filename.wk ".$!."\n";
        $fh->open($filename);
        #print "Searching for ".$key."\n";
        while ( <$fh> ) {
                if ( $_=~/^\Q$key\E/o ) {
                        $update=1;
                        print $fhw $key.$rest."\n";
                }
                else {  
                 print $fhw $_;
                }
        }
        undef $fh;
        if ( $update==0 ) {
                print $fhw $key.$rest."\n";
        }
        undef $fhw;
        copy "$filename.wk", $filename or croak "Unable to update file "
                                ."$filename $!\n";
        }
Revision:	1.10
Committed:	Wed Feb 15 17:14:18 2006 UTC (19 years, 2 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_1_7, V1_1_6, V1_1_5, V1_2_0-cand3, V1_2_0-cand2, V1_2_0-cand1, V1_1_4, V1_1_3, V1_1_2, V1_1_0_reltag8, V1_1_0_reltag7, V1_1_0_reltag6, V1_1_1, V1_1_0_reltag5, V1_1_0_reltag4, V1_1_0_reltag3, V1_1_0_reltag2, V1_1_0_reltag1, V1_1_0_reltag, V1_0_3-p4, V1_1_0_cand3, V1_1_0_cand2, V1_1_0_cand1, HEAD_SM_071214, forV1_1_0, v103_xml_071106, V1_0_3-p3, V1_0_3-p2, V1_1_0, v110p1, V110p6, V110p5, V110p4, V110p3, before110xmlBRmerge, V110p2, V110p1, V1_0_3-p1, V1_0_3
Branch point for:	forBinLess_SCRAM, HEAD_BRANCH_SM_071214, v200branch, v103_with_xml
Changes since 1.9:	+2 -2 lines
Log Message:	Download works properly again...
#	Content
1	#
2	# Utility Routines for the SCRAM tools
3	#
4	# Interface
5	#
6	# dated(testfile,@dependencies) : returns 1 if testfile is older than any of its
7	# dependencies or does not exist
8
9	package SCRAMUtils;
10	require 5.001;
11	require Exporter;
12	@ISA = qw(Exporter);
13	@EXPORT = qw(checkfile updatelookup dated);
14	use Carp;
15
16	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	sub checkfile {
37	my $filename=shift;
38	my $thisfile="";
39	$thisfile=$ENV{LOCALTOP}."/".$filename;
40	return $thisfile, if ( -e $thisfile );
41	$thisfile=$ENV{RELEASETOP}."/".$filename;
42	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	local $_;
56	use FileHandle;
57	my $fhw=FileHandle->new();
58	my $fh=FileHandle->new();
59	open ( $fhw, ">".$filename.".wk" ) \|\|
60	die "Unable to open $filename.wk ".$!."\n";
61	$fh->open($filename);
62	#print "Searching for ".$key."\n";
63	while ( <$fh> ) {
64	if ( $_=~/^\Q$key\E/o ) {
65	$update=1;
66	print $fhw $key.$rest."\n";
67	}
68	else {
69	print $fhw $_;
70	}
71	}
72	undef $fh;
73	if ( $update==0 ) {
74	print $fhw $key.$rest."\n";
75	}
76	undef $fhw;
77	copy "$filename.wk", $filename or croak "Unable to update file "
78	."$filename $!\n";
79	}