view release on metacpan or  search on metacpan

Bio/Root/Storable.pm  view on Meta::CPAN

#----------------------------------------------------------------------

=head2 statefile

  Arg [1]   : string (optional)
  Function  : Accessor for the file to write state into.
              Should not normally use as a setter - let Root::IO
              do this for you.
  Returntype: string
  Exceptions:
  Caller    : Bio::Root::Storable->store
  Example   : my $statefile = $obj->statefile();

=cut

sub statefile{
    my $key = '_statefile';
    my $self  = shift;

    if( @_ ){ $self->{$key} = shift }

    if( ! $self->{$key} ){ # Create a new statefile
        my $workdir  = $self->workdir;
        my $template = $self->template;
        my $suffix   = $self->suffix;

        # TODO: add cleanup and unlink methods. For now, we'll keep the
        # statefile hanging around.
        my @args = ( CLEANUP=>0, UNLINK=>0 );
        if( $template ){ push( @args, 'TEMPLATE' => $template )};
        if( $workdir  ){ push( @args, 'DIR'      => $workdir  )};
        if( $suffix   ){ push( @args, 'SUFFIX'   => $suffix   )};
        my( $fh, $file ) = Bio::Root::IO->new->tempfile( @args );
        # If filehandle is not stored, don't leave it open
        $fh->close;

        $self->{$key} = $file;
    }

    return $self->{$key};
}

#----------------------------------------------------------------------

=head2 workdir

  Arg [1]   : string (optional) (TODO - convert to array for x-platform)
  Function  : Accessor for the statefile directory. Defaults to File::Spec->tmpdir
  Returntype: string
  Exceptions:
  Caller    :
  Example   : $obj->workdir('/tmp/foo');

=cut

sub workdir {
    my $key = '_workdir';
    my $self = shift;
    if( @_ ){
        my $caller = join( ', ', (caller(0))[1..2] );
        $self->{$key} && $self->debug("Overwriting workdir: probably bad!");
        $self->{$key} = shift
    }
    #$self->{$key} ||= $Bio::Root::IO::TEMPDIR;
    $self->{$key} ||= File::Spec->tmpdir();
    return $self->{$key};
}

#----------------------------------------------------------------------

=head2 template

  Arg [1]   : string (optional)
  Function  : Accessor for the statefile template. Defaults to XXXXXXXX
  Returntype: string
  Exceptions:
  Caller    :
  Example   : $obj->workdir('RES_XXXXXXXX');

=cut

sub template {
    my $key = '_template';
    my $self = shift;
    if( @_ ){ $self->{$key} = shift }
    $self->{$key} ||= 'XXXXXXXX';
    return $self->{$key};
}

#----------------------------------------------------------------------

=head2 suffix

  Arg [1]   : string (optional)
  Function  : Accessor for the statefile template.
  Returntype: string
  Exceptions:
  Caller    :
  Example   : $obj->suffix('.state');

=cut

sub suffix {
    my $key = '_suffix';
    my $self = shift;
    if( @_ ){ $self->{$key} = shift }
    return $self->{$key};
}

#----------------------------------------------------------------------

=head2 new_retrievable

  Arg [1]   : Same as for 'new'
  Function  : Similar to store, except returns a 'skeleton' of the calling
              object, rather than the statefile.
              The skeleton can be repopulated by calling 'retrieve'. This
              will be a clone of the original object.
  Returntype: Bio::Root::Storable inhereting object
  Exceptions: