DB-Object
view release on metacpan or search on metacpan
lib/DB/Object.pm view on Meta::CPAN
use strict;
use warnings;
use warnings::register;
use parent qw( Module::Generic DBI );
use vars qw(
$VERSION $AUTOLOAD $CACHE_DIR $CACHE_SIZE $DRIVER2PACK
$ERROR $DEBUG $MOD_PERL $USE_BIND $USE_CACHE $PLACEHOLDER_REGEXP $SERIALISER
$SERIALISATION_VERSION $EXCEPTION_CLASS
);
use Regexp::Common;
use Scalar::Util qw( blessed weaken );
use DB::Object::Cache::Tables;
use DBI;
use JSON;
use Module::Generic::File qw( sys_tmpdir );
use Module::Generic::Global qw( :const );
use POSIX ();
use Wanted;
our $PLACEHOLDER_REGEXP = qr/(?<![?\w])\?(?![?\w])/;
our $EXCEPTION_CLASS = 'DB::Object::Exception';
our $VERSION = 'v1.10.0';
lib/DB/Object.pm view on Meta::CPAN
return( $self->error( "Unable to load Query builder module $query_class: ", $self->error->message ) );
my $o = $query_class->new;
$o->debug( $self->debug );
$o->enhance( $self->{enhance} ) if( CORE::length( $self->{enhance} ) );
if( $self->isa( 'DB::Object::Tables' ) )
{
$o->table_object( $self ) || return( $self->pass_error( $o->error ) );
# Weaken the back-reference from the Query object to its owning Table to break
# the circular reference cycle (Table -> query_object -> Query -> table_object -> Table)
# that prevents Perl's garbage collector from reclaiming old Query objects.
weaken( $o->{table_object} );
$o->database_object( $self->database_object ) || return( $self->pass_error( $o->error ) );
# Also weaken the database_object reference - the dbo is a long-lived singleton
# and does not own Query objects, so a weak reference is safe here.
weaken( $o->{database_object} );
# Set the table alias if any has been set
if( my $table_alias = $self->as )
{
$o->table_alias( $table_alias ) if( defined( $table_alias ) );
}
}
elsif( $self->isa( 'DB::Object' ) )
{
$o->database_object( $self ) || return( $self->pass_error( $o->error ) );
}
lib/DB/Object/Fields/Field.pm view on Meta::CPAN
##----------------------------------------------------------------------------
package DB::Object::Fields::Field;
BEGIN
{
use strict;
use warnings;
use common::sense;
use parent qw( Module::Generic );
use vars qw( $VERSION $FIELD_NAMES $EXCEPTION_CLASS );
use DB::Object::Fields::Overloaded;
use Scalar::Util qw( weaken );
use Module::Generic::Array;
use overload (
'""' => 'as_string',
'bool' => sub{1},
'+' => sub{ &_op_overload( @_, '+' ) },
'-' => sub{ &_op_overload( @_, '-' ) },
'*' => sub{ &_op_overload( @_, '*' ) },
'/' => sub{ &_op_overload( @_, '/' ) },
'%' => sub{ &_op_overload( @_, '%' ) },
'<' => sub{ &_op_overload( @_, '<' ) },
lib/DB/Object/Fields/Field.pm view on Meta::CPAN
# as those predicates always evaluate to NULL (never TRUE) per the SQL standard.
if( !ref( $val ) && uc( $val ) eq 'NULL' )
{
my $null_expr = $op eq '<>' ? "${field} IS NOT NULL" : "${field} IS NULL";
my $null_overloaded = DB::Object::Fields::Overloaded->new(
expression => $null_expr,
field => $self,
query_object => $qo,
debug => $self->debug,
);
weaken( $null_overloaded->{query_object} ) if( $null_overloaded && $null_overloaded->{query_object} );
return( $null_overloaded );
}
# If the value specified in the operation is a placeholder, or a field object or a statement object, we do not want to quote process it
unless( $val =~ /$placeholder_re/ ||
( $self->_is_object( $val ) &&
(
$val->isa( 'DB::Object::Fields::Field' ) ||
$val->isa( 'DB::Object::Statement' )
)
) ||
lib/DB/Object/Fields/Field.pm view on Meta::CPAN
query_object => $qo,
debug => $self->debug,
( defined( $captured_placeholder ) ? ( placeholder => $captured_placeholder ) : () ),
# Actually type() will return us the actual data type, not the driver constant
# type => $self->type,
( defined( $const ) ? ( type => $const ) : () ),
( !defined( $captured_placeholder ) ? ( value => $val ) : () ),
# binded_offset => ( defined( $captured_placeholder ) && defined( $+{index} ) ) ? ( $+{index} - 1 ) : undef,
# types => $types,
);
weaken( $over->{query_object} ) if( $over && $over->{query_object} );
return( $over );
}
sub FREEZE
{
my $self = CORE::shift( @_ );
my $serialiser = CORE::shift( @_ ) // '';
my $class = CORE::ref( $self );
# We keep a strict allow-list to avoid accidentally freezing DBI handles or other
lib/DB/Object/Query.pm view on Meta::CPAN
package DB::Object::Query;
BEGIN
{
use strict;
use warnings;
use parent qw( DB::Object );
use vars qw( $VERSION $DEBUG $EXCEPTION_CLASS );
use DB::Object::Query::Clause;
use DB::Object::Query::Elements;
use DB::Object::Query::Element;
use Scalar::Util qw( weaken );
use Wanted;
our $DEBUG = 0;
our $EXCEPTION_CLASS = $DB::Object::EXCEPTION_CLASS;
our $VERSION = 'v0.10.0';
};
use strict;
use warnings;
sub init
lib/DB/Object/Query.pm view on Meta::CPAN
sub new_clause
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
$opts->{debug} = $self->debug if( !exists( $opts->{debug} ) );
$opts->{query_object} = $self;
my $o = DB::Object::Query::Clause->new( %$opts ) ||
return( $self->error( "Unable to create a DB::Object::Query::Clause object: ", DB::Object::Query::Clause->error ) );
# Weaken the back-reference to the query object to prevent circular reference memory leaks.
weaken( $o->{query_object} ) if( $o->{query_object} );
return( $o );
}
sub new_element
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
$opts->{debug} = $self->debug if( !exists( $opts->{debug} ) );
$opts->{query_object} = $self;
my $elem = DB::Object::Query::Element->new( %$opts ) ||
return( $self->pass_error( DB::Object::Query::Element->error ) );
# Weaken the back-reference to the query object to prevent circular reference memory leaks.
weaken( $elem->{query_object} ) if( $elem->{query_object} );
return( $elem );
}
sub new_elements
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
$opts->{debug} = $self->debug if( !exists( $opts->{debug} ) );
$opts->{query_object} = $self;
my $e = DB::Object::Query::Elements->new( %$opts ) ||
return( $self->pass_error( DB::Object::Query::Elements->error ) );
# Weaken the back-reference to the query object to prevent circular reference memory leaks.
weaken( $e->{query_object} ) if( $e->{query_object} );
return( $e );
}
sub order { return( shift->_group_order( 'order', 'order_by', @_ ) ); }
sub pass_error
{
my $self = shift( @_ );
# Propagating an error also taints this query object.
lib/DB/Object/Statement.pm view on Meta::CPAN
my $new_table = '';
my $new_db = '';
my $class = ref( $self );
my $q_source = $q->clone;
# clone() does a shallow copy - $q_source->{elements} would share the same object
# as $q->{elements}. Any subsequent _save_bind() on $q would then corrupt the
# element list of the cached statement. We reset elements here so $q_source gets
# its own fresh object, populated by _query_components below.
$q_source->{elements} = $q_source->new_elements;
# clone() copies the hash shallowly, which means {table_object} is a strong reference
# in the clone even though _query_object_create() weakens it for freshly created query
# objects. If left strong, $q_source permanently retains the table object, which in turn
# retains every new query object created by _reset_query() on each execute() cycle,
# causing an ~8 MB per-iteration memory leak. Weaken it here to restore correct ownership.
Scalar::Util::weaken( $q_source->{table_object} ) if( $q_source->{table_object} && !Scalar::Util::isweak( $q_source->{table_object} ) );
Scalar::Util::weaken( $q_source->{database_object} ) if( $q_source->{database_object} && !Scalar::Util::isweak( $q_source->{database_object} ) );
my $q_target;
# On the duplicated table object, add the current table in the join
$q_source->join_tables( $tbl_o ) if( !$q_source->join_tables->length );
# $data is a DB::Object::Postgres::Statement object - we get all its parameter and merge them with ours
# if( ref( $data ) && ref( $data ) eq $class )
if( ref( $data ) && $self->_is_a( $data, $class ) )
{
$q_target = $data->query_object;
}
( run in 0.702 second using v1.01-cache-2.11-cpan-39bf76dae61 )