Sometimes I make programs that could require some hours to run. This is usually to analyse some gigs of compressed data, or things like that, so I need to use them occasionally. The issue is that I would like to interrupt the process (e.g. to go home when I'm at work, or simply because I need 5 minutes of CPU) and let it resume without the need to restart it from the beginning.
Thus, I thought to program something that would support state preserving without too much hassle for the user (me :); of course, at the moment "state" means variable values, not other things. I started from vars and added some stuff to support this, here's what came out.
package vars::persistent;
=head1 NAME
vars::persistent - Perl pragma to predeclare persistent global variabl
+e names
=head1 SYNOPSIS
use vars::persistent qw($frob @mung %seen);
use vars::persistent '<file name.dat', qw($frob @mung %seen);
vars::persistent::checkpoint('file name here'); # save variables
vars::persistent::checkpoint(); # use last file na
+me
vars::persistent::restore('file name.dat'); # restore saved va
+riables
vars::persistent::restore(); # ditto, with last
+ file name
=head1 DESCRIPTION
This pragmatic module works much like L<vars>, from which the main imp
+ort routine
has been taken. In addition, each variable declared here is also track
+ed, so that
you can save them all to a file or retrieve their values, which can co
+me handy if
you're making an application which needs to save its state and retriev
+e it later.
See L<perlmodlib/Pragmatic Modules> and L<vars>.
=head2 IMPORT
You specify variables to I<use> much like the L<var> pragmatic module.
+ You
cannot use sigils C<*> and C<&>, which aren't storable.
You can optionally specify a filename prepending a C<<> to it.
=head2 FUNCTIONS
=cut
use 5.006;
use warnings::register;
use strict qw(vars subs);
use Storable;
our $VERSION = '1.01';
my @variables;
my $filename;
sub import {
my $callpack = caller;
my ($pack, @imports) = @_;
my $filename;
my ($sym, $ch);
foreach (@imports) {
if (($ch, $sym) = /^([\$\@\%])(.+)/) {
if ($sym =~ /\W/) {
# time for a more-detailed check-up
if ($sym =~ /^\w+[[{].*[]}]$/) {
require Carp;
Carp::croak(
"Can't declare individual elements of hash or array"
+);
}
elsif (warnings::enabled()
and length($sym) == 1
and $sym !~ tr/a-zA-Z//)
{
warnings::warn("No support for built-in vars");
} ## end elsif (warnings::enabled(...
elsif (($^H &= strict::bits('vars'))) {
require Carp;
Carp::croak(
"'$_' is not a valid variable name under strict vars
+");
}
} ## end if ($sym =~ /\W/)
$sym = "${callpack}::$sym" unless $sym =~ /::/;
*$sym = (
$ch eq "\$" ? \$$sym
: $ch eq "\@" ? \@$sym
: $ch eq "\%" ? \%$sym
: do {
require Carp;
Carp::croak("'$_' is not a valid variable name");
} ## end do
);
push @variables, [$sym, $ch];
} ## end if (($ch, $sym) = /^([\$\@\%\*\&])(.+)/)
elsif (($ch, $sym) = /^([\>\:])(.+)/) {
if ($ch eq '>') { $filename = $sym }
else {
# Import routine inside...
}
}
else {
require Carp;
Carp::croak("'$_' is not a valid variable name");
}
} ## end foreach (@imports)
restore($filename) if ($filename);
} ## end sub import
=over 5
=item my $ris = checkpoint($filename);
Make a checkpoint, i.e. save specified variables to $filename. If omit
+ted, last
value specified in either C<checkpoint> or C<restore> (see below) is u
+sed.
Returns undef if file could not be opened, 1 otherwise.
=cut
sub checkpoint {
my ($f) = @_;
$filename = $f if defined $f;
open my $fh, ">", $filename or return;
foreach (@variables) {
my ($sym, $sigil) = @$_;
my $s = (
$sigil eq "\$" ? \$$sym
: $sigil eq "\@" ? \@$sym
: $sigil eq "\%" ? \%$sym
: undef
);
next unless $s;
Storable::nstore_fd($s, $fh);
} ## end foreach (@variables)
close $fh;
return 1;
} ## end sub checkpoint
=item my $ris = restore($filename);
Restore variable values from $filename. If omitted, last
value specified in either C<checkpoint> above or C<restore> is used.
Returns undef if file could not be opened, 1 otherwise.
=cut
sub restore {
my ($f) = @_;
$filename = $f if defined $f;
open my $fh, "<", $filename or return;
foreach (@variables) {
my $iref = Storable::fd_retrieve($fh);
my ($sym, $sigil) = @$_;
if ($sigil eq '$') { $$sym = $$iref }
elsif ($sigil eq '@') { @$sym = @$iref }
elsif ($sigil eq '%') { %$sym = %$iref }
} ## end foreach (@variables)
close $fh;
return 1;
} ## end sub restore
1;
__END__
=back
=head1 EXAMPLE
Suppose you have a program that must do lengthy calculations. You may
need your computer at some time, so you could like to stop the calcula
+tions
for a while, then restore them later - this module aims to help you do
that seamlessly (more or less).
# Yes, you'll get global variables... The following declaration will
# preload values for variables if "file.dat" is present
use vars::persistent '<file.dat' qw( $foo @bar %baz );
# Initialisation unless $foo is already defined, assuming it is if
# the file is present
unless (defined $foo) {
$foo = 0;
@bar = qw( follow me );
%baz = ( a => 10, b => [12, 35], c => { d => 'hallo', e => 'all'})
+;
}
# Install termination handler to save upon exit
my $exit_please;
$SIG{__TERM__} = sub { $exit_please = -1 unless $exit_please; exit(0)
+ }
# Start long calculation that relies on above state variables
# We assume that the single cycle can be taken to the end before
# exiting here
while (! $exit_please) {
# Perform something here. Set $exit_please to 1 if calculation is
# terminated. And yes, I don't want to care about race conditions
# now...
}
# Save state variables for next time, if applicable
vars::persistence::checkpoint() if $exit_please < 0;
=head1 BUGS
There are lots of bugs, but that's the real puzzle for you to solve -
+where are they?
I should learn how to export the two functions.
No attempt to preserve integrity during save is attempted. I should re
+ally
save to a temporary, then move to the target file.
=head1 AUTHOR
I don't know who the author of vars.pm is.
Flavio Poletti E<lt>flavio@polettix.itE<gt>
=head1 COPYRIGHT AND LICENSE
A big chunk of this module is from the author(s) of vars.pm.
I did not find their copyright notice, but I assume that it
is the same as Perl itself being a CORE module. The rest of
the stuff is Copyright (C) 2005 by Flavio Poletti
For the same reason, I assume that the following should be
quite fair:
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.
=cut
I also did a simple test script:
#!/usr/bin/perl
use strict;
use warnings;
use Test::More 'no_plan';
#########################
# Three variables used as constants in the following
my $rfoo = 10;
my @rbar = qw( ciao a tutti );
my %rbaz = ( first => 'aaaa', second => ['bbbb'], third => { yes => 'a
+nd so on'} );
# Declare three persistent variables. The mechanism is the
# same as use vars.
use vars::persistent qw( $foo @bar %baz );
# Initialise to the constant values above
$foo = $rfoo;
@bar = @rbar;
%baz = %rbaz;
# Silly verification here
is($foo, $rfoo, "scalar value");
is_deeply(\@bar, \@rbar, "array");
is_deeply(\%baz, \%rbaz, "hash");
# Checkpoint, i.e. save to file
vars::persistent::checkpoint('savefile');
# Reset values
$foo = 0;
@bar = ();
%baz = ();
# Restore from file
vars::persistent::restore(); # file name is cached
# These tests are the real one now
is($foo, $rfoo, "scalar value");
is_deeply(\@bar, \@rbar, "array");
is_deeply(\%baz, \%rbaz, "hash");
I feel like I'm reinventing some wheel here, but it was not much work and, moreover, the most similar concept was maybe that of
, which was a bit overkill here - I liked the idea to save and restore variables directly, instead of having some interface structure to work with.
I also know that there is much, much space for improvement, so I'd like to have some feedback from you wised monks :)