| 1 |
– |
#____________________________________________________________________ |
| 2 |
– |
# File: CacheUtilities.pm |
| 3 |
– |
#____________________________________________________________________ |
| 4 |
– |
# |
| 5 |
– |
# Author: Shaun Ashby <Shaun.Ashby@cern.ch> |
| 6 |
– |
# Update: 2003-10-30 11:51:58+0100 |
| 7 |
– |
# Revision: $Id$ |
| 8 |
– |
# |
| 9 |
– |
# Copyright: 2003 (C) Shaun Ashby |
| 10 |
– |
# |
| 11 |
– |
#-------------------------------------------------------------------- |
| 12 |
– |
|
| 13 |
– |
=head1 NAME |
| 14 |
– |
|
| 15 |
– |
Cache::CacheUtilities - Utilities for reading and writing of cache files. |
| 16 |
– |
|
| 17 |
– |
=head1 SYNOPSIS |
| 18 |
– |
|
| 19 |
– |
Reading: |
| 20 |
– |
|
| 21 |
– |
print "Reading cached data","\n",if ($ENV{SCRAM_DEBUG}); |
| 22 |
– |
$cacheobject=&Cache::CacheUtilities::read($cachename); |
| 23 |
– |
|
| 24 |
– |
Writing: |
| 25 |
– |
|
| 26 |
– |
&Cache::CacheUtilities::write($cacheobject,$cachename); |
| 27 |
– |
|
| 28 |
– |
=head1 DESCRIPTION |
| 29 |
– |
|
| 30 |
– |
Functions for reading and writing of cache files. This uses Storable::store() to |
| 31 |
– |
write out Perl data structures to files. For reading, the complete data structure |
| 32 |
– |
is read from the cache file using Storable::retrieve() which returns a variable |
| 33 |
– |
containing the original object. |
| 34 |
– |
|
| 35 |
– |
=head1 METHODS |
| 36 |
– |
|
| 37 |
– |
=over |
| 38 |
– |
|
| 39 |
– |
=cut |
| 40 |
– |
|
| 1 |
|
package Cache::CacheUtilities; |
| 2 |
|
require 5.004; |
| 3 |
< |
|
| 4 |
< |
use IO::File; |
| 5 |
< |
use English; |
| 6 |
< |
use Exporter; |
| 7 |
< |
|
| 48 |
< |
use Storable; |
| 49 |
< |
|
| 50 |
< |
@ISA=qw(Exporter); |
| 51 |
< |
|
| 52 |
< |
# |
| 53 |
< |
# Common functions for interacting with caches: |
| 54 |
< |
# |
| 55 |
< |
|
| 56 |
< |
=item C<read($cachefilename)> |
| 57 |
< |
|
| 58 |
< |
Read the cache file $cachefilename and return a Perl object. |
| 59 |
< |
|
| 60 |
< |
=cut |
| 3 |
> |
use Data::Dumper; |
| 4 |
> |
BEGIN { |
| 5 |
> |
$Cache::CacheUtilities::zipUntility="GZip"; |
| 6 |
> |
$Data::Dumper::Varname='cache'; |
| 7 |
> |
} |
| 8 |
|
|
| 9 |
|
sub read() |
| 10 |
|
{ |
| 11 |
< |
my ($cachefilename) = @_; |
| 12 |
< |
# Retrieve the cached object from the file: |
| 13 |
< |
$cache = eval "retrieve(\"$cachefilename\")"; |
| 14 |
< |
die "Cache load error: ",$EVAL_ERROR,"\n", if ($EVAL_ERROR); |
| 11 |
> |
my ($file) = @_; |
| 12 |
> |
my $data=(); |
| 13 |
> |
my $func="read${zipUntility}"; |
| 14 |
> |
&$func($file,\$data); |
| 15 |
> |
my $cache = eval "$data"; |
| 16 |
> |
die "Cache $file load error: ",$@,"\n", if ($@); |
| 17 |
|
return $cache; |
| 18 |
|
} |
| 19 |
|
|
| 71 |
– |
=item C<write($cacheobject,$cachefilename)> |
| 72 |
– |
|
| 73 |
– |
Dump the Perl object $cacheobject to a file $cachefilename. |
| 74 |
– |
|
| 75 |
– |
=cut |
| 76 |
– |
|
| 20 |
|
sub write() |
| 21 |
|
{ |
| 22 |
< |
my ($cacheobject,$cachefilename) = @_; |
| 22 |
> |
my ($cache,$file)=@_; |
| 23 |
|
use File::Copy; |
| 24 |
< |
print "[ CacheUtilities::write() ] Writing cache ",$cachefilename,"\n", if ($ENV{SCRAM_DEBUG}); |
| 25 |
< |
# Move the cache file to make a backup: |
| 26 |
< |
move($cachefilename,$cachefilename.".bak") if ( -r $cachefilename); |
| 27 |
< |
# Use the store method of the Storable package to write out the object to a file: |
| 28 |
< |
eval { |
| 29 |
< |
store($cacheobject,$cachefilename); |
| 30 |
< |
}; |
| 31 |
< |
|
| 32 |
< |
die "Cache write error: ",$EVAL_ERROR,"\n", if ($EVAL_ERROR); |
| 33 |
< |
|
| 34 |
< |
# Change the permissions to -rw-r--r--: |
| 35 |
< |
my $filemode = 0644; |
| 36 |
< |
chmod $filemode, $cachefilename; |
| 37 |
< |
|
| 24 |
> |
if (-r $file){move($file,"${file}.bak");} |
| 25 |
> |
my $ok=1; my $err=""; |
| 26 |
> |
my $fcache=(); |
| 27 |
> |
eval {$fcache=Dumper($cache);}; |
| 28 |
> |
if ($@){$err=$@;$ok=0;} |
| 29 |
> |
else |
| 30 |
> |
{ |
| 31 |
> |
my $func="write${zipUntility}"; |
| 32 |
> |
$ok = &$func($fcache,$file); |
| 33 |
> |
} |
| 34 |
> |
if ($ok) |
| 35 |
> |
{ |
| 36 |
> |
unlink ("${file}.bak"); |
| 37 |
> |
my $mode=0644; |
| 38 |
> |
chmod $mode,$file; |
| 39 |
> |
} |
| 40 |
> |
else |
| 41 |
> |
{ |
| 42 |
> |
if (-r "${file}.bak"){move("${file}.bak",$file);} |
| 43 |
> |
die "ERROR: Writing Cache file $file: $err\n"; |
| 44 |
> |
} |
| 45 |
|
return; |
| 46 |
|
} |
| 47 |
+ |
|
| 48 |
+ |
###### Using gzip ################# |
| 49 |
+ |
sub readGZip() |
| 50 |
+ |
{ |
| 51 |
+ |
my $file = shift; |
| 52 |
+ |
my $data = shift; |
| 53 |
+ |
my $gz; |
| 54 |
+ |
if (open($gz,"gzip -cd $file |")) |
| 55 |
+ |
{ |
| 56 |
+ |
binmode $gz; |
| 57 |
+ |
my $buf; |
| 58 |
+ |
while (read($gz,$buf,1024*1024) > 0){${$data}.=$buf;} |
| 59 |
+ |
close($gz); |
| 60 |
+ |
} |
| 61 |
+ |
else{die "Can not open file for reading using \"gzip\": $file\n";} |
| 62 |
+ |
return; |
| 63 |
+ |
} |
| 64 |
|
|
| 65 |
< |
1; |
| 66 |
< |
|
| 67 |
< |
|
| 68 |
< |
=back |
| 69 |
< |
|
| 70 |
< |
=head1 AUTHOR/MAINTAINER |
| 71 |
< |
|
| 72 |
< |
Shaun Ashby |
| 65 |
> |
sub writeGZip() |
| 66 |
> |
{ |
| 67 |
> |
my ($cache,$file) = @_; |
| 68 |
> |
my $gz; |
| 69 |
> |
if (open($gz,"| gzip >$file")) |
| 70 |
> |
{ |
| 71 |
> |
binmode $gz; |
| 72 |
> |
print $gz $cache; |
| 73 |
> |
close($gz); |
| 74 |
> |
} |
| 75 |
> |
else{die "Can not open file for reading using \"gzip\": $file\n";} |
| 76 |
> |
return 1; |
| 77 |
> |
} |
| 78 |
|
|
| 79 |
< |
=cut |
| 79 |
> |
1; |
