package vars::persistent;

=head1 NAME

vars::persistent - Perl pragma to predeclare persistent global variable 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 name

    vars::persistent::restore('file name.dat');     # restore saved variables
    vars::persistent::restore();                    # ditto, with last file name

=head1 DESCRIPTION

This pragmatic module works much like L<vars>, from which the main import routine
has been taken. In addition, each variable declared here is also tracked, so that
you can save them all to a file or retrieve their values, which can come handy if
you're making an application which needs to save its state and retrieve 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 omitted, last
value specified in either C<checkpoint> or C<restore> (see below) is used.

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 calculations
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 really
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