File Coverage

blib/lib/Class/PObject/Driver/file.pm

Criterion	Covered	Total	%
statement	115	157	73.2
branch	40	66	60.6
condition	16	28	57.1
subroutine	14	14	100.0
pod	5	6	83.3
total	190	271	70.1

package Class::PObject::Driver::file;

# file.pm,v 1.18 2003/09/09 08:46:36 sherzodr Exp

use strict;
#use diagnostics;
use File::Spec;
use Log::Agent;
use Class::PObject::Driver;
use vars ('$f', '$VERSION', '@ISA');
use Fcntl (':DEFAULT', ':flock', ':mode');

@ISA = ("Class::PObject::Driver");
$VERSION = '2.00';
$f = 'obj%05d.cpo';

# called when pobject's save() method is called. Note: this is not
# the same as save() method as the one called by pobject. This is different!
sub save {
    my $self = shift;
    my $class = ref($self) || $self;
    my ($object_name, $props, $columns) = @_;

    logtrc 3, "%s->save()", $class;

    # if 'id' does not already exist, we're being asked to save a newly
    # created object. Before we do that, we create a new id for the object:
    $columns->{id} ||= $self->generate_id($object_name, $props) or return;

    # _filename() returns the name of the file this particular object should
    # be stored in. Look into _filename() for details
    my $filename = $self->_filename($object_name, $props, $columns->{id}) or return;

    # if we can't open the file, we set error message, and return undef
    unless ( sysopen(FH, $filename, O_WRONLY|O_CREAT|O_TRUNC, 0666) ) {
        $self->errstr("couldn't open '$filename': $!");
        logerr $self->errstr;
        return undef
    }
    # we do the same if we can't get exclusive lock on the file
    unless (flock(FH, LOCK_EX) ) {
        $self->errstr("couldn't lock '$filename': $!");
        logerr $self->errstr;
        return undef
    }

    # and store frozen data into file:
    print FH $self->freeze($object_name, $props, $columns);
    # if we can't close the file handle, it means we couldn't store it.
    unless( close(FH) ) {
        $self->errstr("couldn't save the object: $!");
        logerr $self->errstr;
        return undef
    }
    # if everything went swell, we should return object id
    return $columns->{id}
}




sub load_ids {
    my $self = shift;
    my $class = ref($self) || $self;
    my ($object_name, $props, $terms, $args) = @_;

    logtrc 3, "%s->load_ids(@_)", $class;

    # if we come this far, we're being asked to return either all the objects,
    # or by some criteria
    my @data_set  = ( );
    $args       ||= { };

    # to do it, we need to figure out which directory the objects of this
    # type are most likely to be stored. For details look into '_dir()'
    my $object_dir = $self->_dir($object_name, $props) or return;

    # and iterate through each object file. For some reason I prefer using
    # IO::Dir for retrieving objects, seems 'cleaner' this way
    require IO::Dir;
    my %files = ();
    unless(tie %files, "IO::Dir", $object_dir) {
        $self->errstr("couldn't open '$object_dir': $!");
        logerr $self->errstr;
        return undef
    }
    my $n = 0;
    while ( my ($filename, $stat) = each %files ) {
        # if 'limit' was given, and 'offset' is missing and sort is not given,
        # then check we have already reached our 'limit'. Otherwise, we need to
        # load all the objects to the memory before we can return the data set
        if ( defined($args->{limit}) && (!$args->{offset}) && (!$args->{'sort'}) && ($n == $args->{limit}) ) {
            last
        }
        # if it is a directory, then skip to the next file
        if ( S_ISDIR($stat->mode) ) {
            next
        }

        # defining a regex pattern to check against the filename to determine
        # if it can be the file object stored in
        my $filef_pattern = $f;
        $filef_pattern    =~ s/\%\d*d/\\d\+/g;
        $filef_pattern    =~ s/\./\\./g;

        unless ( $filename =~ m/^$filef_pattern$/ ) {
            next
        }
        # we open the file with read-only flag
        unless (sysopen(FH, File::Spec->catfile($object_dir, $filename), O_RDONLY)) {
            $self->errstr("couldn't open '$filename': $!");
            logerr $self->errstr;
            return undef
        }
        unless(flock(FH, LOCK_SH)) {
            $self->errstr("couldn't lock '$filename': $!");
            logerr $self->errstr;
            return undef
        }
        local $/ = undef;
        my $datastr = ; close(FH);
        unless( defined $datastr ) {
            next
        }
        my $data = $self->thaw($object_name, $props, $datastr);
        if ( $self->_matches_terms($data, $terms) ) {
            push @data_set, keys %$args ? $data : $data->{id};
            $n++
        }
    }
    untie(%files);

    # returning post-processed data set
    unless ( keys %$args ) {
        return \@data_set
    }

    my $data_set = $self->_filter_by_args(\@data_set, $args);
    return [ map { $_->{id} } @$data_set ]
}














# load_by_id() is called only while object is to be retrieved by its id
sub load {
    my $self = shift;
    my $class = ref($self) || $self;
    my ($object_name, $props, $id) = @_;

    logtrc 3, "%s->load(%s)", $class, join ", ", @_;

    # determine the name of the file for this object
    my $filename = $self->_filename($object_name, $props, $id) or return;

    # open that file
    unless ( sysopen(FH, $filename, O_RDONLY) ) {
        $self->errstr("couldn't open '$filename': $!");
        return undef
    }
    # lock the file handle
    unless(flock(FH, LOCK_SH)) {
        $self->errstr("couldn't lock '$filename': $!");
        return undef
    }
    # undefined record separator
    local $/ = undef;
    # slurp the whole file in
    my $data_str = ;
    close(FH);
    unless ( $data_str ) {
        $self->errstr("object is empty");
        return undef
    }
    return $self->thaw($object_name, $props, $data_str)
}




sub remove {
    my ($self, $object_name, $props, $id) = @_;

    my $filename = $self->_filename($object_name, $props, $id);
    unless ( unlink($filename) ) {
        $self->errstr("couldn't unlink '$filename': $!");
        return undef
    }
    return 1
}







sub drop_datasource {
    my ($self, $object_name, $props, $i) = @_;


    my $dir = $self->_dir($object_name, $props);
    logtrc 3, "removing '%s'", $dir;
    require File::Path;
    unless ( File::Path::rmtree($dir) ) {
        $self->errstr( "couldn't unlink '%s': %s", $dir, $!);
        return undef
    }
    return 1
}







sub generate_id {
    my ($self, $object_name, $props) = @_;

    my $dir = $self->_dir($object_name, $props) or return;

    my $filename = File::Spec->catfile($dir, 'counter.cpo');

    unless (sysopen(FH, $filename, O_RDWR|O_CREAT)) {
        $self->errstr("couldn't open/create '$filename': $!");
        return undef
    }
    unless (flock(FH, LOCK_EX) ) {
        $self->errstr("couldn't lock '$filename': $!");
        return undef
    }
    my $num =  || 0;
    unless (seek(FH, 0, 0)) {
        $self->errstr("couldn't seek to the start of '$filename': $!");
        return undef
    }
    unless (truncate(FH, 0)) {
        $self->errstr("couldn't truncate '$filename': $!");
        return undef
    }
    print FH ++$num, "\n";
    unless(close(FH)) {
        $self->errstr("couldn't update '$filename': $!");
        return undef
    }
    return $num
}




sub _filename {
    my ($self, $object_name, $props, $id) = @_;

    unless ( $object_name && defined($id) ) {
        logcroak "Usage: _filename(\$id)";
    }
    my $dir = $self->_dir($object_name, $props) or return;
    return File::Spec->catfile($dir, sprintf($f, $id))
}


sub _dir {
    my ($self, $object_name, $props) = @_;

    my ($object_dir, $object_name_as_str);
    my $dir         = $props->{datasource};

    # if 'datasource' was not specified, we should
    # create a location for object of this type in the
    # system's temp folder:
    unless ( defined $dir ) {
        $dir = File::Spec->tmpdir()
    }

    # creating a dirified version of the object name
    $object_name_as_str = $object_name;
    $object_name_as_str =~ s/\W+/_/g;
    $object_dir         = File::Spec->catfile($dir, $object_name_as_str);

    # if the directory that we just created doesn't exist,
    # we should create it
    unless ( -e $object_dir ) {
        require File::Path;
        unless (File::Path::mkpath($object_dir) ) {
            $self->errstr("couldn't create datasource '$object_dir': $!");
            return undef
        }
    }
    # return the directory
    return $object_dir
}

1;

__END__;