Solstice::Model::Freezer - An interface for freeze/thaw based models.


Solstice documentation Contained in the Solstice distribution.

Index


Code Index:

NAME

Top

Solstice::Model::Freezer - An interface for freeze/thaw based models.

SYNOPSIS

Top

# See Solstice::Model.

DESCRIPTION

Top

This module overrides _init and store, using a freeze/thaw mechanism as a data storage engine. It saves/loads everything that is in the accessor definition.

Export

No symbols exported.

Methods

new([$id])

Returns a new object. If an id if passed in, it will be initialized.

store()

Saves the object

delete()

Removes the object from the data store.

getAllIDs()

provides an Solstice::List of all the ids of this class

Private Functions

_getDBPath()

Returns the full path to the object store.

_initialize($id)

Loads the object from DBM::Deep

_getDB()

Returns the DBM::Deep object.

_generateID()

This will generate an id string, if an object doesn't have an existing id.

Modules Used

DBM::Deep, Solstice::Model (Solstice::Model).

AUTHOR

Top

Catalyst Group, <catalyst@u.washington.edu>

VERSION

Top

$Revision: 2393 $

COPYRIGHT

Top


Solstice documentation Contained in the Solstice distribution.
package Solstice::Model::Freezer;

# $Id:$

use 5.006_000;
use strict;
use warnings;

use base qw(Solstice::Model);
use Data::Dumper;
use constant TRUE  => 1;
use constant FALSE => 0;

our ($VERSION) = ('$Revision: 2393 $' =~ /^\$Revision:\s*([\d.]*)/);

sub new {
    my $class = shift;
    my $obj_id = shift;

    my $self = $class->SUPER::new(@_);

    if (defined $obj_id) {
        $self = $self->_initialize($obj_id);
    }

    return $self;
}

sub store {
    my $self = shift;

    my $id = $self->getID();

    if (!defined $id) {
        $id = $self->_generateID();
        $self->_setID($id);
    }

    # Hack a bit so we don't store persistence values... but we don't want to cause problems for people using them.
    my $old_persistence = $self->{'_persistence'};

    $self->clearPersistenceValues();

    my $path = $self->_getDBPath();
    open(my $FH, ">", "$path") or die "Could not open $path to store a freezer model!\n";
    print $FH (Dumper $self);
    close $FH;

    $self->{'_persistence'} = $old_persistence;

    return TRUE;
}

sub delete {
    my $self = shift;

    my $id = $self->getID();

    return FALSE unless defined $id;

    my $path = $self->_getDBPath();

    return unlink $path;
}


sub getAllIDs {

    my $self = shift;

    my $db_dir = $self->_getDBRootPath();

    my $ids = Solstice::List->new();
    opendir(DIR, $db_dir) or die "Could not open $db_dir for reading of Solstice::Model::Freezer objects!\n";
    while( my $item = readdir(DIR) ){
        if( -f "$db_dir/$item"){
            $item =~ s/\.db$//;
            $ids->add($item);
        }
    }
    closedir(DIR);

    return $ids;
}

sub getAll {
    my $self = shift;

    my $list = Solstice::List->new();
    my $iter = $self->getAllIDs()->iterator();
    while( my $id = $iter->next()){
        my $obj = $self->new($id);
        $list->add($obj);
    }
    return $list;
}


sub _getDBPath {
    my $self = shift;

    my $id = $self->getID();

    return $self->_getDBRootPath()."/$id.db";
}

sub _getDBRootPath {
    my $self = shift;

    my $ref = ref $self || $self;
    $ref =~ s/[^a-z]+/_/gi;

    my $data_root = $self->getConfigService()->getDataRoot();
    $data_root = "$data_root/model_freezer_data/$ref/";
    $self->_dirCheck($data_root);

    return $data_root;
}




sub _initialize {
    my $self = shift;
    my $id   = shift;

    $self->_setID($id);

    my $path = $self->_getDBPath();

    my $text;
    eval {
        local( $/, undef ) ;
        open( my $FH, "<", $path) or die "Couldn't open $path to init a Solstice::Model::Freezer object!\n";
        $text = <$FH>;
    };

    return bless({}, ref $self) if $@;

    my $VAR1;
    eval $text; ##no critic
    die "Could not unthaw Solstice::Model::Freezer object from $path : $@\n" if $@;

    return $VAR1;
}

sub _getDB {
    my $self = shift;
    return DBM::Deep->new(
        file        => $self->_getDBPath(),
        autobless   => TRUE,
    );
}

sub _generateID {
    my $self = shift;

    my $ref = ref $self;
    my $rand1 = rand();
    my $rand2 = rand();
    my $time  = time;

    return "$ref-$rand1-$rand2-$time";
}


1;

__END__