Persistence::Object::Simple - Object Persistence with Data::Dumper.


Object-Persistence documentation Contained in the Object-Persistence distribution.

Index


Code Index:

NAME

Top

Persistence::Object::Simple - Object Persistence with Data::Dumper.

SYNOPSIS

Top

  use Persistence::Object::Simple; 
  my $perobj = new Persistence::Object::Simple ( __Fn   => $path ); 
  my $perobj = new Persistence::Object::Simple ( __Dope => $directory ); 
  my $perobj = new Persistence::Object; 
  my $perobj->commit (); 




DESCRIPTION

Top

P::O::S provides persistence functionality to its objects. Object definitions are stored as stringified perl data structures, generated with Data::Dumper, that are amenable to manual editing and external processing from outside the class interface.

Persistence is achieved with a blessed hash container that holds the object data. The container can store objects that employ non-hash structures as well. See "Inheriting Persistence::Object::Simple", "Class Methods" and the persistent list class example (examples/Plist.pm).

CONSTRUCTOR

Top

new()

Creates a new Persistent Object or retrieves an existing object definition. Takes a hash argument with following possible keys:

__Fn

Pathname of the file that contains the persistent object definition. __Fn is treated as the object identifier and required at object retrieval.

__Dope

The Directory of Persistent Entities. P::O::S generates a unique filename to store object data in the specified directory. The object identifier is the complete pathname of the object's persistent image and is placed in the __Fn instance variable. This argument is ignored when __Fn is provided.

__Create

A boolean attribute that can either take a "Yes" or a "No" value. It informs the method whether to create an object image if one doesn't already exist. __Create is "yes" by default.

__Random

Random string used as input for computing the unique object name. This should be used when unpredictable object names are required for security reasons. The random string can be generated with Crypt::Random, a module which provides cryptographically secure random numbers.

When new() is called without any arguments it uses a unique file in the default DOPE, "/tmp", to store the object definition. The default DOPE can be altered with the dope() method.

 $po = new Persistence::Object::Simple 
       ( __Fn => "/tmp/codd/suse5.2.codd" ); 

 # -- generates a unique filename  in /tmp/codd
 $po  = new Persistence::Object::Simple
       ( __Dope => "/tmp/codd" );     
 print $po->{ __Fn }; 

 # -- generates a unique filename in defalt dope (/tmp)
 $po  = new Persistence::Object::Simple; 
 print $po->{ __Fn }; 

METHODS

Top

commit()

Commits the object to disk. Like new() it takes __Fn and __Dope arguments, but __Dope takes precedence. When a __Dope is provided, the directory portion of the object filename is ignored and the object is stored in the specified directory.

    $perobj->commit (); 
    $perobj->commit (  __Fn   => $foo ); 
    $perobj->commit (  __Dope => $bar ); 







Commit() can also store non-object data refs. See "Class Methods".

expire()

Irrevocably destructs the object. Removes the persistent entry from the DOPE.

    $perobj->expire (); 

If you want to keep a backup of the object before destroying it, use commit() to store in a different location. Undefing $obj->{ __Fn } before writing to the disk will force commit() to store the object in a unique file in the specified DOPE.

    $perobj->{ __Fn } = undef; 
    $perobj->commit ( __Dope => "/tmp/dead" ); 
    $perobj->expire (); 

move()

Moves the object to a different DOPE.

    $perobj->move ( __Dope => "/some/place/else" ); 

Specifying __Fnalter attribute will force move() to drop the existing file name and generate a new one in specified directory. This can be useful when backing up objects that may have the same filename.

    $perobj-> ( __Dope => 'queues/backup', 
                __Fnalter => 1 ); 

lock()

Gets an exclusive lock. The owner of the lock can commit() without unlocking.

    $perobj->lock (); 

unlock()

Releases the lock.

    $perobj->unlock ();

dumper()

Returns the Data::Dumper instance bound to the object. Should be called before commit() to change Data::Dumper behavior.

    my $dd = $perobj->dumper (); 
    $dd->purity (1); 
    $dd->terse  (1);  # -- smaller dumps. 
    $perobj->commit (); 

See Data::Dumper.

load()

Class method that retrieves and builds the object. Takes a filename argument. Don't call this directly, use new () for object retrieval.

    Persistence::Object::Simple->load ( 
        __Fn => '/tmp/dope/myobject' 
    ); 




Inheriting Persistence::Object::Simple

Top

In most cases you would want to inherit this module. It does not provide instance data methods so the object data functionality must be entirely provided by the inheriting module. Moreover, if you use your objects to store refs to class data, you'd need to bind and detach these refs at load() and commit(). Otherwise, you'll end up with a separate copy of class data with every object which will eventually break your code. See perlobj, perlbot, and perltoot, on why you should use objects to access class data.

Persistence::Database inherits this module to provide a transparently persistent database class. It overrides new(), load() and commit() methods. There is no class data to bind/detach, but load() and commit() are overridden to serve as examples/templates for derived classes. Data instance methods, AUTOLOADed at runtime, automatically commit() when data is stored in Instance Variables. For more details, Read The Fine Sources.

Class Methods

Top

load() and commit() can be used for storing non-object references. commit() and load() can be invoked as class methods with a "Data" argument. Some examples:

 # generates a unique filename in /tmp 
 my $fn = Persistence::Object::Simple->commit (
     __Dope => "/tmp", Data => $x );

 @list = 0..100; 
 Persistence::Object::Simple->commit 
  ( __Fn => '/tmp/datarefs/numbers', 
    Data => \@list; 
  ); 

 $list = Persistence::Object::Simple->load 
  ( __Fn => '/tmp/datarefs/numbers' ); 

 $" = "\n"; print "@$list"; 

SEE ALSO

Top

Data::Dumper(3), Persistence::User(3), perl(1).

AUTHOR

Top

Vipul Ved Prakash, <mail@vipul.net>

COPYRIGHT

Top

CONTRIBUTORS

Top

*

Mike Blazer <blazer@mail.nevalink.ru> helped with the Win32 Port.

*

Holger Heimann <hh@it-sec.de> helped with debugging.

*

Kirrily 'Skud' Robert, <skud@infotrope.net> patched P::O::S to be taint-friendly.


Object-Persistence documentation Contained in the Object-Persistence distribution.
#!/usr/bin/perl -s
##
## Persistence::Object::Simple -- Persistence For Perl5 Objects.  
##
## $Date: 1999/10/13 23:08:43 $
## $Revision: 0.47 $
## $State: Exp $
## $Author: root $
##
## Copyright (c) 1998, Vipul Ved Prakash.  All rights reserved.
## This code is free software; you can redistribute it and/or modify
## it under the same terms as Perl itself.

package Persistence::Object::Simple;
use Digest::MD5; 
use Data::Dumper;
use Carp;
use Fcntl;
use vars qw( $VERSION );

( $VERSION )  = '$Revision: 0.92 $' =~ /\s+(\d+\.\d+)\s+/;  #-- Module Version

my $DOPE      = "/tmp";     #-- The default Directory Of Persistent Entities
my $MAXTRIES  = 250;        #-- TTL counter for generating a unique file

sub dope {                  #-- Default DOPE access method

    my ( $self, $dope ) = @_;
    ${ $self->{ __DOPE } } = $dope if $dope;
    ${ $self->{ __DOPE } };

}
                                
sub new {                   #-- Constructor.  Creates and inits a P::O::S 
                            #-- object instance. Binds class data. 

    my ( $class, %args ) = @_; 
    my $self = {}; 
    my $fn = $args{ __Fn };     
    my $exists; 
	$args{ __Create } ||= "";
    if ($args{ __Create } and lc($args{ __Create }) eq "no") {
        $exists = 1; 
    }

    return undef if !(-e $fn) && $exists; 
    unless ( $fn ) { 
        $fn = $class->uniqfile ( $args{ __Dope } || $DOPE, $args{ __Random } );
        return undef unless $fn;
    }

    $self->{ __Fn } = $fn; 
    $self->{ __DOPE } = \$DOPE; 

    
    my $existing = $class->load ( __Fn => $fn );  
    $self = $existing if $existing;              
    for ( keys %args ) { $self->{ $_ } = $args{ $_ } }  

    bless $self, $class; 

} 

sub dumper {                #-- Returns the Data::Dumper object associated 
                            #-- with the instance
    my $self = shift; 

    $self->{ __Dumper } = new Data::Dumper ( [ $self ] ); 
    return $self->{ __Dumper }; 

}

sub commit {                #-- Commits the object to disk.  Works as a class
                            #-- method as well.  
    my ( $self, %args ) = @_; 
    my $class = ref $self || $self;
    my ( $d, $fn );
    $fn = $args{ __Fn }  || $self->{ __Fn }; 

    if ( ref $self ) { 
        $d = $self->{ __Dumper } || $self->dumper () ;
    } else {  # -- Whoa! It's a class method!
        $d = new Data::Dumper ( [ $args{ Data } ] ); 
    } 

    if ( $args{ __Dope } && $fn ) {  # -- change to a new dope
            $fn =~ s:.*/::; 
            $args{ __Dope } =~ s:/$::;
            $fn = $args{ __Dope } . "/$fn"; 
            croak "$fn exists. Can't overwrite." if -e $fn;
    }
 
    unless ( $fn ) {  # -- generate a uniq filename in the
        $args{ __Dope } = $DOPE unless $args{ __Dope }; # -- new dope
        $fn = $class->uniqfile ( $args{ __Dope } );
    }

   
    my $locked_fh = $self->{ __Lock }; 
    seek $locked_fh, 0, 0 if $locked_fh;
    my $fh; 

    # -- delete extra object data and class data-refs if this looks like 
    # -- an object. 
    if ( ref $self ) { 
        for ( keys %$self ) { delete $self->{ $_ } 
            if /^__(?:Dumper|DOPE|Fn|Lock|Create)/ }; 
    }

    unless ( $locked_fh ) { 
        # guard against disallowed characters in filename (basically those 
        # which might mess up the open() call)
        if (($fn) = ($fn =~ /^([^<>|+]+)$/)) {
            open C, ">$fn" || croak "Can't open $fn for writing."; 
            eval { flock C, 2 }; undef $@;
            $fh = *C{ IO }; 
        } else {
            die "Filename '$fn' contains inappropriate characters";
        }
    } 

    print { $locked_fh ? $locked_fh : $fh } 
	defined &Data::Dumper::Dumpxs ? $d->Dumpxs() : $d->Dump(); 
    close $fh if $fh; 

    if ( ref $self ) { 
        $self->{ __Fn } = $fn; 
        $self->{ __Lock } = $locked_fh if $locked_fh; 
    }

    return $fn; 

} 

sub load { 

    my ( $class, %args ) = @_; 

    return undef unless -e $args{ __Fn };
    
    open C, $args{ __Fn } || croak "Couldn't open $args{ __Fn }."; 
    eval { flock C, 2 }; undef $@;

    local $/ = undef; # slurp mode
    my $objectfile = <C>; 
    close C; 

    # untaint the input meaningfully
    if ($objectfile =~ /^(\$VAR1 = bless[^;]+;)$/s) {
        my $object = eval "$1";
        croak "$args{ __Fn } is corrupt. Object loading aborted." if $@; 

        $object->{ __Fn } = $args{ __Fn } if ref $object eq 'HASH';
        return $object; 
    } elsif ($objectfile =~ /^$/) {
        return undef;
    } else {
        croak "Tainted data from $args{__Fn} looks unsafe. Object loading aborted.";
    }
}

sub expire { 

    my ( $self ) = @_; 
    my $fn = $self->{ __Fn };
    return 1 if unlink $fn; 

} 

sub move { 

    my ( $self, %args ) = @_; 
    my   $class = ref $self; 

    $self->expire (); 
    $self->{ __Fn } = undef if $args{ __Fnalter };
    my $fn = $self->commit ( %args ); 

    my $moved = $class->new ( __Fn => $fn ); 
    $self = $moved; 

}

sub lock { 

    my ( $self ) = @_; 

    my $fn = $self->{ __Fn }; 
	$self->commit unless -e $fn; 
    open ( F, "+<$fn" ) || croak "Couldn't open $fn for locking. Commit first!"; 
    eval { flock F, 2 }; undef $@;
    $self->{ __Lock } = *F{ IO }; 

}

sub unlock { 

    my ( $self ) = @_; 
    my $F = $self->{ __Lock }; close $F; 
    undef $self->{ __Lock };
    
}

sub uniqfile { 

    my ( $class, $dir, $random ) = @_; 
    my $fn; my $counter; 

    do { 
        $fn = Digest::MD5::md5_hex( "@{[time]}.@{[int rand 2**8]}.$random" ); 
        ($fn) = ($fn =~ m!([^/<>|;]+)!);
        $counter++ ;
    }
    until sysopen ( C, "$dir/$fn" , O_RDWR|O_EXCL|O_CREAT ) 
        or $counter > $MAXTRIES;

    close C; 
    return undef if $counter > $MAXTRIES;
    return "$dir/$fn";
}

'True Value';

__END__