#$Id: Runtime.pm 46153 2007-10-19 00:26:07Z wsnyder $
######################################################################
#
# This program is Copyright 2002-2007 by Wilson Snyder.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either the GNU General Public License or the
# Perl Artistic License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
######################################################################
require 5.006_001;
package Make::Cache::Runtime;
use DirHandle;
use Digest::MD5;
use File::Copy;
use File::Path;
use Storable;
use Carp;
use strict;
our $VERSION = '1.043';
#######################################################################
our $Cache_Dir = undef; # Set/accessed with cache_dir function
#######################################################################
sub cache_dir {
$Cache_Dir ||= $ENV{OBJCACHE_RUNTIME_DIR} || "/usr/local/common/lib/runtime";
$Cache_Dir = shift if $_[0];
return $Cache_Dir;
}
sub format_time {
my $secs = shift;
my $include_hours = shift;
# Hopefully, no hours!
if ($include_hours || $secs>=3600) {
return sprintf ("%02d:%02d:%02d", int($secs/3600), int(($secs%3600)/60), $secs % 60);
} else {
return sprintf ("%02d:%02d", int(($secs)/60), $secs % 60);
}
}
sub write {
my %params = (dir => cache_dir(), # Directory to put results into
#key => , # Key to be stored
#persist => {}, # Reference to hash to be stored
@_);
$params{key} or die "%Error: Expecting key=> parameter, ";
$params{persist} or die "%Error: Expecting key=> parameter, ";
# We store it under a digest to allow for non-filename allowed characters
my $key_digest = Digest::MD5::md5_hex($params{key});
(my $key_prefix = $key_digest) =~ s/^(..).*$/$1/;
my $path = "$params{dir}/${key_prefix}";
# Ignore errors, as two processes may be doing this at once
# If the output dir isn't made the storable creation will catch it
eval { my_mkpath ($path); };
my $filename = "$path/${key_digest}.runtime";
print "Make::Cache::Runtime::write $filename\n" if $::Debug;
my $newfile = "${filename}.new$$";
Storable::nstore ($params{persist}, $newfile);
chmod 0777, $newfile;
# Do the copy as one atomic op to prevent a race case with another reader
move ($newfile, "$filename");
}
sub read {
my %params = (dir => cache_dir(), # Directory to put results into
#key => , # Key to be stored
@_);
# Returns reference to persistent structure, undef if no data known
my $key_digest = Digest::MD5::md5_hex($params{key});
(my $key_prefix = $key_digest) =~ s/^(..).*$/$1/;
my $filename = "$params{dir}/${key_prefix}/${key_digest}.runtime";
# We can't have storable open the file for us, as there may be a race
# where the file exists with -r, then gets replaced.
my $fd = IO::File->new("<$filename");
return undef if !$fd;
my $persistref;
eval { $persistref = Storable::fd_retrieve($fd); }; # Ignore errors
return $persistref;
}
sub dump {
my %params = (dir => cache_dir(), # Directory to put results into
@_);
my $path = $params{dir};
my $dir = new DirHandle $path or return;
my %lines;
while (defined(my $basefile = $dir->read)) {
my $file = "$path/$basefile";
if ($file =~ /\.runtime$/) {
my $persistref = Storable::retrieve($file);
my $date = (stat($file))[9];
my ($a,$b,$c,$day,$month,$year,$d,$e,$f) = localtime($date);
$date = sprintf("%04d/%02d/%02d", $year+1900,$month+1,$day);
(my $showfile = $basefile) =~ s/\.runtime//;
$lines{$persistref->{prog}.$persistref->{key}}
= sprintf ("\t%-9s %-8s %-11s %s %s\n",
$persistref->{prog}||'?',
format_time($persistref->{runtime},1),
$date,
$showfile,
$persistref->{key});
}
}
foreach (sort(keys %lines)) { print $lines{$_}; }
}
sub my_mkpath {
my($paths, $verbose, $mode) = @_;
# $paths -- either a path string or ref to list of paths
# $verbose -- optional print "mkdir $path" for each directory created
# $mode -- optional permissions, defaults to 0777
#
# Like File::Path::mkpath, where this is from.
# But that insists on printing messages and failing when it doesn't
# work, which can happen when many processes are executing in parallel
local($")="/";
$mode = 0777 unless defined($mode);
$paths = [$paths] unless ref $paths;
my (@created,$path);
foreach $path (@$paths) {
$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
next if -d $path;
my $parent = File::Basename::dirname($path);
unless (-d $parent or $path eq $parent) {
push(@created,my_mkpath($parent, $verbose, $mode));
}
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
my $e = $!;
# allow for another process to have created it meanwhile
#croak "mkdir $path: $e" unless -d $path;
}
push(@created, $path);
}
@created;
}
#######################################################################
1;
__END__
=pod
=head1 NAME
Make::Cache::Runtime - Simple database of completion times
=head1 SYNOPSIS
$string = format_time($seconds, $true_to_including_hours);
Make::Cache::Runtime::write (key=>$key,
persist=>{testing_persistence=>1},
);
my $persistref = Make::Cache::Runtime::read (key=>'make::runtime testing',);
=head1 DESCRIPTION
Make::Cache::Runtime allows for storing and retrieving persistent state,
namely expected runtime of gcc and tests.
Data is stored in a global directory, presumably under NFS mount across all
systems. While this does not allow atomic access to files, it does provide
fast, catchable access to the database.
=head1 METHODS
=over 4
=item cache_dir
Return the default directory name for the cache. With optional argument,
set the cache directory name. Defaults to OBJCACHE_RUNTIME_DIR.
=item $string = format_time($seconds, $true_to_including_hours);
Return the time in seconds as a string in MM:SS format. With true second
argument, return as HH:MM:SS.
=item write (key=>$key, persist=>$ref);
Hash the key, and write a database entry file with a copy of the data in
the persist reference. With dir=> named parameter, use database in that
directory. Note to prevent problems between different versions of perl, you
may want to include the Perl version number in the key hash.
=item my $ref = read (key=>$key);
Return a object reference for the data stored under the given key, or undef
if not found. With dir=> named parameter, use database in that directory.
=item dump()
Print a summary of the runtime database for debugging. With dir=> named
parameter, use database in that directory.
=back
=head1 FILES
/usr/local/common/lib/runtime Default for cache_dir()
=head1 ENVIRONMENT
=over 4
=item OBJCACHE_RUNTIME_DIR
Specifies the directory containing the runtime database. Defaults to
/usr/local/common/lib/runtime.
=back
=head1 DISTRIBUTION
The latest version is available from CPAN and from L<http://www.veripool.com/>.
Copyright 2000-2007 by Wilson Snyder. This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License or the Perl Artistic License.
=head1 AUTHORS
Wilson Snyder <wsnyder@wsnyder.org>
=head1 SEE ALSO
L<objcache>, L<Make::Cache>
=cut
######################################################################
syntax highlighted by Code2HTML, v. 0.9.1