view release on metacpan or  search on metacpan

lib/Acme/State.pm  view on Meta::CPAN

            for my $k (keys %$tree) {
                if($k =~ m/::$/) {
                    caller_cv(0)->($package.$k, $tree->{$k});
                } elsif(ref($tree->{$k})) {
                    *{$package.$k} = $tree->{$k};
                } else {
                    die $package.$k . " doesn't contain a ref";
                }
            }
        }->('main::', $save);
    }

}

sub save_file_name {
    my $zero = $0 || 'untitledprogram';
    $zero =~ s{.*/}{};
    return +(getpwuid $<)[7].'/'.$zero.'.store';
}

sub save_state {

    our $wantcoderefs;

    my $tree = sub {
        my $package = shift;
        my $node = shift() || { };
        no strict 'refs';
        for my $k (keys %$package) {
            next if $k =~ m/main::$/;
            next if $k =~ m/[^\w:]/;
            next if grep $_ eq $k, @stop_modules;
            if($k =~ m/::$/) {
                # recurse into that namespace unless it corresponds to a .pm module that got used at some point
                my $modulepath = $package.$k; 
                for($modulepath) { s{^main::}{}; s{::$}{}; s{::}{/}g; $_ .= '.pm'; }
                next if exists $INC{$modulepath};
                $node->{$k} ||= { };
                caller_cv(0)->($package.$k, $node->{$k});
            } elsif( *{$package.$k}{HASH} ) {
                $node->{$k} = *{$package.$k}{HASH};
            } elsif( *{$package.$k}{ARRAY} ) {
                $node->{$k} = *{$package.$k}{ARRAY};
            } elsif( *{$package.$k}{CODE} ) {
                next unless $wantcoderefs;
                # save coderefs but only if they aren't XS (can't serialize those) and weren't exported from elsewhere.
                my $ob = B::svref_2object(*{$package . $k}{CODE});
                my $rootop = $ob->ROOT;
                my $stashname = $$rootop ? $ob->STASH->NAME . '::' : '(none)'; 
                if($$rootop and ($stashname eq $package or 'main::'.$stashname eq $package or $stashname eq 'main::' )) {
                    # when we eval something in code in main::, it comes up as being exported from main::.  *sigh*
                    $node->{$k} = *{$package . $k}{CODE};
                }
            } else {
                $node->{$k} = *{$package.$k}{SCALAR} unless ref(*{$package.$k}{SCALAR}) eq 'GLOB';
            }
        }
        return $node;
    }->('main::');

    # use Data::Dumper; print "debug: ", Data::Dumper::Dumper($tree), "\n";

    local $Storable::Deparse = $wantcoderefs;

    my $save_fn = save_file_name();

    # $save_fn =~ s{/-}{/x}g; warn "saving to: ``$save_fn.new''";

    Storable::nstore $tree, $save_fn.'.new' or die "saving state failed: $!";

    # warn "okay, Storable::nstore done";

    rename $save_fn, $save_fn.'.last'; # it's okay if it fails... file might not exist
    rename $save_fn.'.new', $save_fn or die "renaming new save file into place as ``$save_fn'' failed: $!";

    return 1;
}

END {
    STDERR->print("Acme::State:  Saving program state!\n\n");
    save_state();
};



=head1 NAME

Acme::State - Save application state on exit and restores state on startup

=head1 SYNOPSIS

    use Acme::State; 
    our $t; 
    print "t: $t\n"; 
    $t = int rand 100; 
    print "new t: $t\n"; 

... and then run it again.

=head1 DESCRIPTION

Crawls the package hierarchy looking for C<our> variables.
Stores them all off in a file in the home directory of the user running the script.
When the script using this module starts up, this same file is read in and the 
variables are restored.

Serializes scalars, hashes, and arrays declared using C<our>, C<use vars>, or otherwise
not declared using C<my>. 
Uses L<Storable> to write the data.
The save is placed in the home directory of the user the script is executing as.
The file name is the same as the script's name (C<$0>) plus ".save".
It also keeps one backup around, named C<$0.save.last>, and it may leave a
C<$0.save.new> if interrupted.

Web apps written using L<Continuity> get persistant state, so why shouldn't command
line apps?
Hey, and maybe L<Continuity> apps want to persist some state in case the server implodes.
Who knows.

C<$Acme::State::wantcoderefs>, if set true, takes things a step further and tells 
L<Acme::State> to also serialize subroutines it finds.