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__

=head1 NAME

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

=head1 SYNOPSIS

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

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

=head1 ABSTRACT

    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.

=head1 DESCRIPTION

Class::PObject::Driver::DBM is a direct subclass of Class::PObject::Driver, 
and provides all the necessary methods common for DBM-related disk access.

=head1 METHODS

Refer to L<Class::PObject::Driver|Class::PObject::Driver> for the details of all
the driver-specific methods. Class::PObject::Driver::DBM overrides C<save()>,
C<load()> and C<remove()> methods with the versions relevant to DBM-related
disk access.

=over 4

=item *

C<dbh($self, $pobject_name, \%properties, $lock_type)> - called whenever base methods
need database tied hash. DBM drivers should provide this method, which should
return an array of elements, namely C<$DB> - an DBM object, usually returned from
C<tie()> or C<tied()> functions; C<$dbh> - a hash tied to database; C<$unlock> - 
an action required for unlocking the database. C<$unlock> should be a reference 
to a subroutine, which when called should release the lock.

Currently base methods ignore C<$DB>, but it may change in the future.

=item *

C<_filename($self, $pobject_name, \%properties)> - returns a name of the file
to connect to. It first looks for C<$properties->{datasource}> and if it exists,
uses the value as a directory name object file should be created in. If it's missing,
defaults to systems temporary folder.

It then returns a file name derived out of C<$pobject_name> inside this directory.

=item *

C<_lock($file, $filename, $lock_type)> - acquires either shared or exclusive lock depending
on the C<$lock_type>, which can be either of I<w> or I<r>.

Returns a reference to an action (subroutine), which perform unlocking for this particular
lock. On failure returns undef. C<_lock()> is usually called from within C<dbh()>, and return
value is returned together with database handles.

=back

=head1 NOTES

Currently the only record index is the I<id> column. By introducing configurable indexes,
object selections (through C<load()> method) can be improved tremendously. Syntax similar 
to the following may suffice:

    pobject Article => {
        columns         => ['id', 'title', 'author', 'content'],
        indexes         => ['title', 'author'],
        driver          => 'db_file',
        datasource      => './data'
    }
        
This issue is to be addressed in subsequent releases.

=head1 SEE ALSO

L<Class::PObject::Driver>,
L<Class::PObject::Driver::DB_File>
L<Class::PObject::Driver::DBI>

=head1 COPYRIGHT AND LICENSE

For author and copyright information refer to Class::PObject's L<online manual|Class::PObject>.

=cut