# Paranoid::BerkeleyDB::Db -- BerkeleyDB Db Wrapper
#
# (c) 2005 - 2015, Arthur Corliss <corliss@digitalmages.com>
#
# $Id: lib/Paranoid/BerkeleyDB/Db.pm, 2.01 2016/06/17 11:24:54 acorliss Exp $
#
#    This software is licensed under the same terms as Perl, itself.
#    Please see http://dev.perl.org/licenses/ for more information.
#
#####################################################################

#####################################################################
#
# Dbironment definitions
#
#####################################################################

package Paranoid::BerkeleyDB::Db;

use strict;
use warnings;
use vars qw($VERSION);
use Fcntl qw(:DEFAULT :flock :mode :seek);
use Paranoid;
use Paranoid::Debug qw(:all);
use Paranoid::IO;
use Paranoid::IO::Lockfile;
use Paranoid::BerkeleyDB::Core;
use Class::EHierarchy qw(:all);
use BerkeleyDB;

($VERSION) = ( q$Revision: 2.01 $ =~ /(\d+(?:\.\d+)+)/sm );

use vars qw(@ISA @_properties @_methods);

@_properties = (
    [ CEH_PUB | CEH_SCALAR, 'filename' ],
    [ CEH_PUB | CEH_HASH,   'params' ],
    );
@_methods = ( [ CEH_PUB, 'db' ], [ CEH_PUB, 'env' ], );

@ISA = qw(Class::EHierarchy);

#####################################################################
#
# module code follows
#
#####################################################################

{

    my %dbd;    # Object handles
    my %dbp;    # Parameters used for handles
    my %dbc;    # Reference count
    my %pid;    # Object handle create PID

    sub _openDb {

        # Purpose:  Fork/redundant-open safe
        # Returns:  Reference to BerkeleyDB::Db object
        # Usage:    $env = _openDb(%params);

        my %params = @_;
        my ( $db, $env, $c, $home );

        pdebug( 'entering w/%s', PDLEVEL2, %params );
        pIn();

        if ( exists $dbd{ $params{'-Filename'} } ) {
            pdebug( 'database already exists', PDLEVEL3 );

            if ( $pid{ $params{'-Filename'} } == $$ ) {
                pdebug( 'using cached reference', PDLEVEL3 );

                # Increment reference count
                $dbc{ $params{'-Filename'} }++;
                $db = $dbd{ $params{'-Filename'} };

            } else {

                pdebug( 'cached ref created under different pid', PDLEVEL3 );

                # Install DESTROY filters
                _installScreener();
                _addBlacklist( $dbd{ $params{'-Filename'} } );

                # Close everything
                $c = $dbc{ $params{'-Filename'} };
                delete $dbd{ $params{'-Filename'} };
                delete $dbp{ $params{'-Filename'} };
                delete $dbc{ $params{'-Filename'} };
                delete $pid{ $params{'-Filename'} };

                $db = _openDb(%params);
                $dbc{ $params{'-Filename'} } = $c if defined $db;

            }

        } else {

            pdebug( 'creating a new database', PDLEVEL3 );

            # Add default flags if they're omitted
            $params{'-Mode'}  = 0666 & ~umask;
            $params{'-Flags'} = DB_CREATE unless exists $params{'-Flags'};
            $home             = '';

            # Small sleight of hand as we only accept
            # Paranoid::BerkeleyDB::Env objects as -Env
            if (    exists $params{'-Env'}
                and defined $params{'-Env'}
                and $params{'-Env'}->isa('Paranoid::BerkeleyDB::Env') ) {
                $home = $params{'-Env'}->property('home') . '/';
                $params{'-Env'} = $params{'-Env'}->env;
            } else {
                delete $params{'-Env'};
            }
            pdebug( 'final parameters: %s', PDLEVEL4, %params );

            # Create the database
            if (pexclock(
                    "$home$params{'-Filename'}.lock", $params{'-Mode'} )
                ) {
                $db = BerkeleyDB::Btree->new(%params);
                punlock("$home$params{'-Filename'}.lock");
            }

            if ( defined $db ) {
                delete $params{'-Env'};
                $dbd{ $params{'-Filename'} } = $db;
                $dbp{ $params{'-Filename'} } = {%params};
                $dbc{ $params{'-Filename'} } = 1;
                $pid{ $params{'-Filename'} } = $$;
            } else {
                Paranoid::ERROR = pdebug( 'failed to open database: %s %s',
                    PDLEVEL1, $!, $BerkeleyDB::Error );
            }
        }

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL2, $db );

        return $db;
    }

    sub _closeDb {

        # Purpose:  Close db or decrements counter
        # Returns:  Boolean
        # Usage:    $rv = _closeDb(%params);

        my %params = @_;

        pdebug( 'entering w/%s', PDLEVEL2, %params );
        pIn();

        if ( exists $dbd{ $params{'-Filename'} } ) {
            if ( $dbc{ $params{'-Filename'} } == 1 ) {
                pdebug( 'closing out database %s',
                    PDLEVEL4, $dbd{ $params{'-Filename'} } );
                $dbd{ $params{'-Filename'} }->db_sync;
                $dbd{ $params{'-Filename'} }->db_close;
                delete $dbd{ $params{'-Filename'} };
                delete $dbp{ $params{'-Filename'} };
                delete $dbc{ $params{'-Filename'} };
                delete $pid{ $params{'-Filename'} };
            } else {
                pdebug( 'decrementing ref count for %s',
                    PDLEVEL4, $dbd{ $params{'-Filename'} } );
                $dbc{ $params{'-Filename'} }--;
            }
        }

        pOut();
        pdebug( 'leaving w/rv: 1', PDLEVEL2 );

        return 1;
    }

    sub db {

        # Purpose:  Returns a handle
        # Returns:  Ref
        # Usage:    $env = $obj->db;

        my $obj      = shift;
        my $filename = $obj->property('filename');
        my $rv;

        pdebug( 'entering', PDLEVEL1 );
        pIn();

        $rv = $$ == $pid{$filename}
            ? $rv = $dbd{$filename}
            : _openDb( $obj->property('params'),
            '-Env' => defined $obj->env ? $obj->env : undef );

        pOut();
        pdebug( 'leaving w/rv: %s', PDLEVEL1, $rv );

        return $rv;
    }
}

sub _initialize {
    my $obj    = shift;
    my %params = @_;
    my ( $db, $env, $rv );

    # Make sure minimal parameters are preset
    pdebug( 'entering', PDLEVEL1 );
    pIn();

    if ( exists $params{'-Filename'} ) {
        $db = _openDb(%params);

        if ( defined $db ) {

            # Adopt the database
            $env = $params{'-Env'};
            if ( defined $env and $env->isa('Paranoid::BerkeleyDB::Env') ) {
                $env->adopt($obj);
            }
            delete $params{'-Env'};

            $obj->property( 'filename', $params{'-Filename'} );
            $obj->property( 'params',   %params );
            $rv = 1;
        }

    } else {
        Paranoid::ERROR =
            pdebug( 'caller didn\'t specify -Filename', PDLEVEL1 );
    }

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL1, $rv );

    return $rv;
}

sub _deconstruct {
    my $obj    = shift;
    my %params = $obj->property('params');
    my ( $env, $db, $rv );

    pdebug( 'entering', PDLEVEL1 );
    pIn();

    # Close database
    $rv = _closeDb(%params);

    pOut();
    pdebug( 'leaving w/rv: %s', PDLEVEL1, $rv );

    return $rv;
}

sub env {
    my $obj = shift;
    my $p;

    $p = $obj->parent;

    return ( defined $p and $p->isa('Paranoid::BerkeleyDB::Env') )
        ? $p
        : undef;
}

1;

__END__

=head1 NAME

Paranoid::BerkeleyDB::Db -- BerkeleyDB Db Wrapper

=head1 VERSION

$Id: lib/Paranoid/BerkeleyDB/Db.pm, 2.01 2016/06/17 11:24:54 acorliss Exp $

=head1 SYNOPSIS

  $db = Paranoid::BerkeleyDB::Db->new(-Filename => './dbdir/data.db');

  $bdb = $db->db;
  $env = $db->env;

=head1 DESCRIPTION

This module provides an OO-based wrapper for the L<BerkeleyDB::Btree(3)> 
class.  If you're using the L<Paranoid::BerkeleyDB(3)> API this object is 
created for you automatically.  There is probably no value in using this 
module directly.

This class places no restrictions on the use of any available
L<BerkeleyDB::Btree(3)> options.

=head1 SUBROUTINES/METHODS

=head2 new

  $db = Paranoid::BerkeleyDB::Db->new(-Filename => './dbdir/data.db');

The only required argument is B<-Filename>.  For a complete list of all 
available options please see the L<BerkeleyDB(3)> man page.

By default the following settings are applied unless overridden:

    Parameter   Value
    ---------------------------------------------------
    -Flags      DB_CREATE

=head2 db

  $db = $db->db;

This returns a handle to the current L<BerkeleyDB::Btree(3)> object.

=head2 env

  $env = $db->env;

This returns a handle to the associated L<Paranoid::BerkeleyDB::Env(3)> 
object, if one is being used.

=head2 DESTROY

A DESTROY method is provided which should sync and close an open database, as
well as release any locks.

=head1 DEPENDENCIES

=over

=item o

L<BerkeleyDB>

=item o

L<Class::EHierarchy>

=item o

L<Fcntl>

=item o

L<Paranoid>

=item o

L<Paranoid::Debug>

=item o

L<Paranoid::IO>

=item o

L<Paranoid::IO::Lockfile>

=back

=head1 BUGS AND LIMITATIONS

B<-Filename> is interpreted differently depending on whether you're using an
environment or not.  If you're using this module as a standalone DB object any
relative paths are interpreted according to your current working directory.
If you are using an environment, however, it is interpreted relative to that
environment's B<-Home>.

=head1 SEE ALSO

    L<BerkeleyDB(3)>

=head1 HISTORY

02/12/2016  Complete rewrite

=head1 AUTHOR

Arthur Corliss (corliss@digitalmages.com)

=head1 LICENSE AND COPYRIGHT

This software is licensed under the same terms as Perl, itself. 
Please see http://dev.perl.org/licenses/ for more information.

(c) 2005 - 2016, Arthur Corliss (corliss@digitalmages.com)

