Class::PObject::Driver::DBM - Base class for DBM-related pobject drivers

    use Class::PObject::Driver::DBM;
    @ISA = ('Class::PObject::Driver::DBM');

    sub dbh {
        my ($self, $pobject_name, $properties) = @_;
        ...
    }

    Class::PObject::Driver::DBM is a base class for all the DBM-related
    pobject drivers. Class::PObject::Driver::DBM is a direct subclass of
    Class::PObject::Driver.

    pobject Article => {
        columns         => ['id', 'title', 'author', 'content'],
        indexes         => ['title', 'author'],
        driver          => 'db_file',
        datasource      => './data'
    }

package Class::PObject::Driver::DBM;

# DBM.pm,v 1.8 2003/09/09 00:11:54 sherzodr Exp

use strict;
#use diagnostics;
use Carp;
use Class::PObject::Driver;
use File::Spec;
use Fcntl (':DEFAULT', ':flock');
use vars ('$VERSION', '@ISA', '$lock');

@ISA = ('Class::PObject::Driver');

$VERSION = '2.00';


sub save {
    my ($self, $object_name, $properties, $columns) = @_;
    
    my (undef, $dbh, $unlock) = $self->dbh($object_name, $properties, 'w') or return undef;
    unless ( $columns->{id} ) {
        my $lastid = $dbh->{_lastid} || 0;
        $columns->{id} = ++$dbh->{_lastid}
    }
    $dbh->{ "!ID:" . $columns->{id} } = $self->freeze($object_name, $properties, $columns);
    $unlock->();
    return $columns->{id}
}



sub load_ids {
    my ($self, $object_name, $properties, $terms, $args) = @_;

    my (undef, $dbh, $unlock) = $self->dbh($object_name, $properties) or return undef;
    my @data_set = ();
    my $n = 0;
    while ( my ($k, $v) = each %$dbh ) {
        if ( $args && $args->{limit} && !$args->{offset} && !$args->{sort} ) {
            $n++ == $args->{limit} and last
        }
        $k =~ /!ID:/ or next;
        my $data = $self->thaw( $object_name, $properties, $v );
        if ( $self->_matches_terms($data, $terms) ) {
            push @data_set, keys %$args ? $data : $data->{id}
        }
    }
    $unlock->();
    unless ( keys %$args ) {
        return \@data_set
    }
    my $data = $self->_filter_by_args(\@data_set, $args);
    return [ map { $_->{id} } @$data ]
}






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

    my (undef, $dbh, $unlock) = $self->dbh($object_name, $props) or return undef;
    return $self->thaw($object_name, $props, $dbh->{ "!ID:" . $id })
}


















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

    
    my (undef, $dbh, $unlock) = $self->dbh($object_name, $properties, 'w') or return undef;
    delete $dbh->{ "!ID:" . $id };
    $unlock->();
    return 1
}










sub _lock {
    my $self = shift;
    my ($file, $type) = @_;
    
    $file    .= '.lck';
    my $lock_flags = $type eq 'w' ? LOCK_EX : LOCK_SH;

    require Symbol;
    my $lock_h = Symbol::gensym();
    unless ( sysopen($lock_h, $file, O_RDWR|O_CREAT, 0666) ) {
        $self->errstr("couldn't create/open '$file': $!");
        return undef
    }
    unless (flock($lock_h, $lock_flags)) {
        $self->errstr("couldn't lock '$file': $!");
        close($lock_h);
        return undef
    }
    return sub { 
        close($lock_h);
        unlink $file
    }
}













1;
__END__