Make::Cache::Runtime - Simple database of completion times

   $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',);

# See copyright, etc in below POD section.
######################################################################

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.052';

#######################################################################

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}";
    my $filename = "$path/${key_digest}.runtime";
    print "Make::Cache::Runtime::write $filename\n" if $::Debug;
    my $newfile = "${filename}.new$$";
    # Ignore errors, as two processes may be doing this at once
    # If the output dir isn't made the storable creation will catch it
    # And if it fails, we'll live.
    my $check = eval {
	my_mkpath ($path);
	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");
	'ok';
    };
    if ($check ne 'ok') {
	warn "-Info: Runtime stashing failed:".($@||"")."\n";
    }
}

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__

######################################################################