view release on metacpan or  search on metacpan

lib/DB/Object.pm  view on Meta::CPAN

        driver   => $driver,
        port     => $port,
        database => $database,
        tables   => $tables,
    };
    if( !defined( $cache_tables->set( $cache ) ) )
    {
        warn( "Unable to write to tables cache: ", $cache_tables->error, "\n" );
    }
    return( $self );
}

sub connect_via { return( shift->_set_get_scalar( 'connect_via', @_ ) ); }

sub constant_queries_cache_get
{
    my( $self, $def ) = @_;
    my $base_class  = $self->base_class;

    # Because we need the database object to revive the statement handler after having thawed it.
    if( ref( $self ) ne $base_class )
    {
        return( $self->error( "This method must be called by the database object itself." ) );
    }

    my $dbo         = $self;
    my $cache_size  = $dbo->cache_size // 0;

    if( !defined( $def ) || ref( $def // '' ) ne 'HASH' )
    {
        return( $self->error( "Parameter provided must be a hash, but I got '", $self->_str_val( $def // 'undef' ), "'." ) );
    }

    foreach my $k ( qw( pack file line ) )
    {
        return( $self->error( "Parameter \"$k\" is missing from the hash." ) )
            if( !defined( $def->{ $k } ) || !CORE::length( $def->{ $k } // '' ) );
    }

    my $cache_key   = CORE::join( '|', @$def{qw( pack file line )} );
    my $serialiser  = CORE::delete( $def->{serialiser} ) || $DB::Object::SERIALISER || 'Storable';

    my $lock;
    my $repo = Module::Generic::Global->new( queries_cache => $base_class,
        max_size    => $cache_size,
        serialiser  => $serialiser,
        key         => $cache_key,
    ) || return( $self->pass_error( Module::Generic::Global->error ) );
    $repo->lock;

    my $store = $repo->get;
    return( '' ) if( !$store );

    # $ts is thee timestamp of the file recorded at the time
    my $ts = $store->{ts} || return( $self->error( "No timestamp set in this constant statement object." ) );
    my $sth = $repo->{sth} || return( '' );
    # A DB::Object::Statement object
    my $qo = $sth->query_object;
    return( '' ) if( !CORE::length( $def->{file} ) );
    return( '' ) if( !-e( $def->{file} ) );
    return( '' ) if( ( CORE::stat( $def->{file} ) )[9] != $ts );
    return( $self->error( "Query object retrieved from constant query cache is void!" ) ) if( !$qo );
    return( $self->error( "Query object retrieved from constant query cache is not a DB::Object::Query object or one of its sub classes." ) ) if( !$self->_is_object( $qo ) || !$qo->isa( 'DB::Object::Query' ) );
    return if( $self->database ne $qo->database_object->database );

    return( $sth );
}

sub constant_queries_cache_set
{
    my( $self, $def ) = @_;
    my $base_class = $self->base_class;

    # Because we need the database object to revive the statement handler after having thawed it.
    if( ref( $self ) ne $base_class )
    {
        return( $self->error( "This method must be called by the database object itself." ) );
    }


    if( !defined( $def ) || ref( $def // '' ) ne 'HASH' )
    {
        return( $self->error( "Parameter provided must be a hash, but I got '", $self->_str_val( $def // 'undef' ), "'." ) );
    }

    foreach my $k ( qw( pack file line ) )
    {
        if( !defined( $def->{ $k } ) || !CORE::length( $def->{ $k } // '' ) )
        {
            return( $self->error( "Parameter \"$k\" is missing from the hash." ) );
        }
    }

    my $dbo        = $self;
    my $cache_size = $dbo->cache_size // 0;

    return( $self->error( "Parameter \"query_object\" is missing from the hash." ) )
        if( !defined( $def->{query_object} ) );

    if( !$self->_is_object( $def->{query_object} ) ||
        !$def->{query_object}->isa( 'DB::Object::Query' ) )
    {
        return( $self->error( "Provided query object is not a DB::Object::Query." ) );
    }

    $def->{ts} = [CORE::stat( $def->{file} )]->[9];

    my $cache_key   = CORE::join( '|', @$def{qw( pack file line )} );
    my $serialiser  = CORE::delete( $def->{serialiser} ) || $DB::Object::SERIALISER || 'Storable';

    my $repo = Module::Generic::Global->new( queries_cache => $base_class,
        max_size    => $cache_size,
        serialiser  => $serialiser,
        key         => $cache_key,
    ) || return( $self->pass_error( Module::Generic::Global->error ) );
    $repo->lock;
    $repo->set( $def ) || return( $self->pass_error( $repo->error ) );

    return( $def );
}

sub constant_queries_cache_del
{
    my( $self, $def ) = @_;
    my $base_class = $self->base_class;

    # Because we need the database object to revive the statement handler after having thawed it.
    if( ref( $self ) ne $base_class )
    {
        return( $self->error( "This method must be called by the database object itself." ) );
    }

    if( !defined( $def ) || ref( $def // '' ) ne 'HASH' )
    {
        return( $self->error( "Parameter provided must be a hash, but I got '", $self->_str_val( $def // 'undef' ), "'." ) );
    }

    foreach my $k ( qw( pack file line ) )
    {
        return( $self->error( "Parameter \"$k\" is missing from the hash." ) )
            if( !defined( $def->{ $k } ) || !CORE::length( $def->{ $k } // '' ) );
    }

    my $dbo         = $self;
    my $cache_size  = $dbo->cache_size // 0;
    my $cache_key   = CORE::join( '|', @$def{qw( pack file line )} );
    my $serialiser  = CORE::delete( $def->{serialiser} ) || $DB::Object::SERIALISER || 'Storable';

    my $repo = Module::Generic::Global->new( queries_cache => $base_class,
        max_size    => $cache_size,
        serialiser  => $serialiser,
        key         => $cache_key,
    ) || return( $self->pass_error( Module::Generic::Global->error ) );
    $repo->lock;
    $repo->remove;
    $repo->unlock;
    return(1);
}

# See also datatype_to_constant()
sub constant_to_datatype
{
    my $self = shift( @_ );
    return unless( scalar( @_ ) && defined( $_[0] ) );
    my $this = shift( @_ );
    my $ref = $self->datatypes;