File Coverage

blib/lib/Script/Resume.pm

Criterion	Covered	Total	%
statement	15	100	15.0
branch	0	40	0.0
condition	0	20	0.0
subroutine	5	17	29.4
pod	7	11	63.6
total	27	188	14.3

package Script::Resume;

use strict;
use vars qw($VERSION);
use Data::Dumper;
use File::Basename;
use FileHandle;

$VERSION = '1.0';

our $NAME = "Script::Resume";

# SCRIPT_STATE - Script specific state (ref to a ref to an object or hash or array or scalar)
# STATE_FILE   - File to store state of everything
# RESUME       - Continue where left off (default = 1)
# DEBUG        - Print out debug info
# RETAIN_STATE - Keep the state around even after the script finishes
#                (You'll want to delete this by hand before running the script again)
# STAGES       - The list of stage names
# STOP_AFTER   - Stop after state X is run.
sub new
{
  my $this = shift;
  my $class = ref($this) || $this;
  my %opts = @_;
  my $tmpdir = $ENV{TEMP} || $ENV{TMP} || "/tmp";
  my $def_state_file = "$tmpdir/" . basename($0) . ".state";

  my $self = { _istate => {ORDER => 0,
                           STOP_AFTER => $opts{STOP_AFTER},
                           SFILE => $opts{STATE_FILE} || $def_state_file,
                           DEBUG => $opts{DEBUG},
                           RETAIN_STATE => $opts{RETAIN_STATE}},
               _stages => {},
               _estate => {RESULTS => {}}};

  $self->{_estate}->{SCRIPT} = ${$opts{SCRIPT_STATE}} if $opts{SCRIPT_STATE};
  bless $self, $class;

  $self->debug("Resume: unlinking file $opts{RESUME}"), unlink($self->{_istate}->{SFILE}) if (defined $opts{RESUME} && $opts{RESUME} == 0);
  $self->{_istate}->{SFH} = new FileHandle($self->{_istate}->{SFILE}, O_RDWR|O_CREAT) or die "$NAME: Couldn't open state file $self->{_istate}->{SFILE}: $!\n";

  $self->addStages(@{$opts{STAGES}}) if $opts{STAGES};
  $self->readState($opts{SCRIPT_STATE});

  return $self;
}

# NAME
# FUNC
# ALWAYS
# ORDER
sub addStage
{
  my $self = shift;
  my $name = shift;
  my $caller_name = $name;
  $caller_name = $self->getCallingPackage() . "::$caller_name" unless (index($caller_name, "::") >= 0);

  die "$NAME: addStage: Need a name for the stage" unless $name;
  %{$self->{_stages}->{$name}} = @_;
  $self->{_stages}->{$name}->{FUNC} = \&{$caller_name} unless $self->{_stages}->{$name}->{FUNC};
  $self->{_stages}->{$name}->{ORDER} = ++$self->{_istate}->{ORDER} unless defined $self->{_stages}->{$name}->{ORDER};
  $self->debug("Adding stage = $name order = $self->{_stages}->{$name}->{ORDER}");
  die "$NAME: FUNC for stage $name not defined\n" unless defined &{$self->{_stages}->{$name}->{FUNC}};
}

sub getCallingPackage
{
  my $self = shift;
  my $i = 0;
  my $caller;
  while ( ($caller = (caller($i))[0]) eq $NAME) {
    $i++;
  }

  return $caller;
}


sub addStages
{
  my $self = shift;
  $self->addStage($_) foreach @_;
}

sub setStageAttributes
{
  my $self = shift;
  my $name = shift;
  my %opts = @_;

  die "$NAME: addStage: Need a name for the stage" unless $name;
  die "$NAME: No such stage $name\n" unless $self->{_stages}->{$name};

  $self->{_stages}->{$name}->{$_} = $opts{$_} foreach (keys %opts);
}

sub debug
{
  my $self = shift;

  return unless $self->{_istate}->{DEBUG};
  my $msg = shift;
  print "$NAME: $msg\n";
}

sub readState
{
  my $self = shift;
  my $script_state = shift;
  my $fh = $self->{_istate}->{SFH};
  my $dumpy;

  $fh->seek(0,0);

  $dumpy = join("", <$fh>);

  if ($dumpy) {
    my $VAR1;
    $self->{_estate} = eval($dumpy);
    die "$NAME: Couldn't read in state: $@\n" if $@;
    $$script_state = $self->{_estate}->{SCRIPT} if ($script_state);
    return 1;
  }
  return 0;
}

sub runAllStages
{
  my $self = shift;
  my $stage;
  foreach $stage (sort {$self->{_stages}->{$a}->{ORDER} <=> $self->{_stages}->{$b}->{ORDER}} keys %{$self->{_stages}}) {
    $self->runStage($stage, @_);
  }
}

sub runStage
{
  my $self = shift;
  my $name = shift;

  $self->debug("Running Stage: $name"), $self->{_estate}->{RESULTS}->{$name} = [&{$self->{_stages}->{$name}->{FUNC}}(@_)] if ($self->{_stages}->{$name}->{ALWAYS} || ! defined $self->{_estate}->{RESULTS}->{$name}); # RJP: remove the "defined" and replace RESULTS with RUN
  #$self->{_estate}->{RUN}->{$name} = 1; #RJP

  $self->writeState();
  $self->debug("Stopping after $name because STOP_AFTER = $name"), exit(0) if $self->{_istate}->{STOP_AFTER} eq $name;
  return wantarray ? @{$self->{_estate}->{RESULTS}->{$name}} : $self->{_estate}->{RESULTS}->{$name}->[0];
}

sub writeState
{
  my $self = shift;

  return if $self->{_istate}->{DONE};
  my $fh = $self->{_istate}->{SFH};
  $fh->seek(0,0);
  print $fh Dumper($self->{_estate});
  $fh->flush();
}

sub doneEarly
{
  my $self = shift;
  $self->{_istate}->{DONE} = 1;
}

sub DESTROY
{
  my $self = shift;
  $self->writeState();
  $self->{_istate}->{SFH}->close();

  unlink $self->{_istate}->{SFILE} if (!$self->{_istate}->{RETAIN_STATE} && ($self->{_istate}->{DONE} || scalar keys %{$self->{_stages}} == scalar keys %{$self->{_estate}->{RESULTS}}));#RUN - RJP
}

1;

__END__