view release on metacpan or search on metacpan
lib/DB/Object.pm view on Meta::CPAN
sub ALL { return( shift->_operator_object_create( 'DB::Object::ALL', @_ ) ); }
sub AND { return( shift->_operator_object_create( 'DB::Object::AND', @_ ) ); }
sub ANY { return( shift->_operator_object_create( 'DB::Object::ANY', @_ ) ); }
sub auto_convert_datetime_to_object { return( shift->_set_get_scalar( 'auto_convert_datetime_to_object', @_ ) ); }
sub auto_decode_json { return( shift->_set_get_scalar( 'auto_decode_json', @_ ) ); }
sub attribute($;$@)
{
my $self = shift( @_ );
# $h->{AttributeName} = ...; # set/write
# ... = $h->{AttributeName}; # get/read
# 1 means that the attribute may be modified
# 0 mneas that the attribute may only be read
my $name = shift( @_ ) if( @_ == 1 );
my %arg = ( @_ );
my %attr =
(
lib/DB/Object.pm view on Meta::CPAN
if( exists( $attr{ $name } ) &&
defined( $value ) &&
$attr{ $name } )
{
$self->{dbh}->{ $name } = $value;
}
}
}
}
sub available_drivers(@)
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
# @ary = DBI->available_drivers( $quiet );
return( $class->SUPER::available_drivers( 1 ) );
}
sub base_class
{
my $self = shift( @_ );
lib/DB/Object.pm view on Meta::CPAN
my $self = shift( @_ );
my $name = shift( @_ ) || return( $self->error( "No name for this query cache was provided." ) );
my $sth = shift( @_ ) || return( $self->error( "No statement handler was provided." ) );
return( $QUERIES_CACHE->{ $name } = $sth );
}
sub cache_table { return( shift->_set_get_boolean( 'cache_table', @_ ) ); }
sub cache_tables { return( shift->_set_get_object( 'cache_tables', 'DB::Object::Cache::Tables', @_ ) ); }
sub check_driver()
{
my $self = shift( @_ );
my $driver = shift( @_ ) || return( $self->error( "No SQL driver provided to check" ) );
my $ok = undef();
local $_;
my @drivers = $self->available_drivers();
foreach( @drivers )
{
if( m/$driver/s )
{
lib/DB/Object.pm view on Meta::CPAN
@$ref{ @$keys } = @$opts{ @$keys };
return(0) if( !scalar( keys( %$ref ) ) );
$self->insert( $ref );
return(1);
}
sub create_db { return( shift->error( "The driver has not implemented the create database method create_db." ) ); }
sub create_table { return( shift->error( "The driver has not implemented the create table method create_table." ) ); }
sub data_sources($;\%)
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
my $opt;
$opt = shift( @_ ) if( @_ );
my $driver = $self->{driver} || return( $self->error( "No driver to to use to check for data sources." ) );
return( $class->SUPER::data_sources( $driver, $opt ) );
}
sub data_type
lib/DB/Object.pm view on Meta::CPAN
# Returns an hash of SQL constant name to its value
sub datatypes
{
my $self = shift( @_ );
my $dict = $self->datatype_dict || return( $self->pass_error );
my $ref = +{ map{ $_ => $dict->{ $_ }->{constant} } keys( %$dict ) };
return( $ref );
}
sub disconnect($)
{
my $self = shift( @_ );
# my( $pack, $file, $line ) = caller();
# print( STDERR "disconnect() called from package '$pack' in file '$file' at line '$line'.\n" );
my $rc = $self->{dbh}->disconnect( @_ );
return( $rc );
}
sub do($;$@)
{
my $self = shift( @_ );
# $rc = $dbh->do( $statement ) || die( $dbh->errstr );
# $rc = $dbh->do( $statement, \%attr ) || die( $dbh->errstr );
# $rv = $dbh->do( $statement, \%attr, @bind_values ) || ...
# my( $rows_deleted ) = $dbh->do(
# q{
# DELETE FROM table WHERE status = ?
# }, undef(), 'DONE' ) || die( $dbh->errstr );
my $query = shift( @_ );
lib/DB/Object.pm view on Meta::CPAN
sub driver { return( shift->_set_get( 'driver' ) ); }
sub enhance
{
my $self = shift( @_ );
my $prev = $self->{enhance};
$self->{enhance} = shift( @_ ) if( @_ );
return( $prev );
}
sub err(@)
{
my $self = shift( @_ );
# $rv = $h->err;
if( defined( $self->{sth} ) )
{
return( $self->{sth}->err() );
}
elsif( $self->{dbh} )
{
return( $self->{dbh}->err() );
lib/DB/Object.pm view on Meta::CPAN
sub errno
{
goto( &err );
}
sub errmesg
{
goto( &errstr );
}
sub errstr(@)
{
my $self = shift( @_ );
if( !ref( $self ) )
{
return( $DBI::errstr || $DB_ERRSTR );
}
elsif( defined( $self->{sth} ) && $self->{sth}->errstr() )
{
return( $self->{sth}->errstr() );
}
lib/DB/Object.pm view on Meta::CPAN
my $sth = $dbh->prepare( $query ) ||
return( $self->error( "Unable to set options '", CORE::join( ', ', @query ), "'" ) );
$sth->execute();
$sth->finish();
return( $self );
}
}
sub passwd { return( shift->_set_get_scalar( 'passwd', @_ ) ); }
sub ping(@)
{
#return( shift->{ 'dbh' }->ping );
my $self = shift( @_ );
return( $self->{dbh}->ping );
}
sub ping_select(@)
{
my $self = shift( @_ );
# $rc = $dbh->ping;
# Some new ping method replacement.... See Apache::DBI
# my( $dbh ) = @_;
my $ret = 0;
eval
{
local( $SIG{__DIE__} ) = sub{ return( 0 ); };
local( $SIG{__WARN__} ) = sub{ return( 0 ); };
lib/DB/Object.pm view on Meta::CPAN
my $opts = $self->_get_args_as_hash( @_ );
$opts->{debug} = $self->debug if( !exists( $opts->{debug} ) );
my $obj = DB::Object::Placeholder->new( %$opts ) ||
return( $self->pass_error( DB::Object::Placeholder->error ) );
return( $obj );
}
sub port { return( shift->_set_get_number( 'port', @_ ) ); }
# Gateway to DB::Object::Statement
sub prepare($;$)
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
my $query = shift( @_ );
my $opt_ref = shift( @_ ) || undef();
my $base_class = $self->base_class;
my $q;
if( $self->_is_a( $query => 'DB::Object::Query' ) )
{
$q = $query;
lib/DB/Object.pm view on Meta::CPAN
return( $self->_make_sth( "${base_class}::Statement", $data ) );
}
else
{
my $err = $@ || $self->{dbh}->errstr() || 'Unknown error while cache preparing query.';
$self->{query} = $query;
return( $self->error( $err ) );
}
}
sub query($$)
{
my $self = shift( @_ );
my $sth = $self->prepare( @_ );
my $result;
if( $sth && !( $result = $sth->execute() ) )
{
return;
}
else
{
lib/DB/Object.pm view on Meta::CPAN
{
return( exists( $ref->{ $type } ) ? $ref->{ $type } : undef() );
}
else
{
return( wantarray() ? () : undef() ) if( !%$ref );
return( wantarray() ? %$ref : $ref );
}
}
sub state(@)
{
my $self = shift( @_ );
# $str = $h->state;
if( !ref( $self ) )
{
return( $DBI::state );
}
else
{
return( $self->SUPER::state() );
lib/DB/Object/Mysql.pm view on Meta::CPAN
sub init
{
my $self = shift( @_ );
$self->SUPER::init( @_ );
$self->{ 'driver' } = 'mysql';
return( $self );
}
# End of generic routines
# ROUTINES PROPRIETAIRE
sub attribute($;$@)
{
my $self = shift( @_ );
# $h->{AttributeName} = ...; # set/write
# ... = $h->{AttributeName}; # get/read
# 1 means that the attribute may be modified
# 0 mneas that the attribute may only be read
my $name = shift( @_ ) if( @_ == 1 );
my %arg = ( @_ );
my %attr =
(
lib/DB/Object/Mysql.pm view on Meta::CPAN
if( exists( $attr{ $name } ) &&
defined( $value ) &&
$attr{ $name } )
{
$self->{dbh}->{ $name } = $value;
}
}
}
}
sub begin_work($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 1;
$self->{AutoCommit_previous} = $self->{dbh}->{AutoCommit};
$self->{dbh}->{AutoCommit} = 0;
return( $self );
}
sub commit($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 0;
$self->{dbh}->commit( @_ );
$self->{dbh}->{AutoCommit} = $self->{AutoCommit_previous} if( length( $self->{AutoCommit_previous} ) );
return( $self );
}
sub connect
{
lib/DB/Object/Postgres.pm view on Meta::CPAN
return( $self );
}
# Get/set alias
# sub alias
# sub as_string
# sub avoid
sub attribute($;$@)
{
my $self = shift( @_ );
# $h->{AttributeName} = ...; # set/write
# ... = $h->{AttributeName}; # get/read
# 1 means that the attribute may be modified
# 0 mneas that the attribute may only be read
my $name = shift( @_ ) if( @_ == 1 );
my %arg = ( @_ );
my %attr =
(
lib/DB/Object/Postgres.pm view on Meta::CPAN
$attr{ $name } )
{
$self->{dbh}->{ $name } = $value;
}
}
}
}
# sub available_drivers(@)
sub begin_work($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 1;
return( $self->{dbh}->begin_work( @_ ) );
}
# This method is common to DB::Object and DB::Object::Statement
# sub bind
# sub cache
# sub check_driver(@;$@)
sub commit($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 0;
return( $self->{dbh}->commit( @_ ) );
}
# Inherited by DB::Object, however, DB::Object::connect() will call our subroutine
# _dbi_connect which format in a particular way the dsn.
sub connect
{
lib/DB/Object/Postgres.pm view on Meta::CPAN
{
$dbh->pg_notifies;
};
if( $@ )
{
return( $self->error( "Error calling PostgreSQL function pg_notifies: $@" ) );
}
return( $ref );
}
sub pg_ping(@)
{
return( shift->{dbh}->pg_ping );
}
# See DB::Object
# sub ping(@)
# See DB::Object
# sub prepare($;$)
lib/DB/Object/Postgres.pm view on Meta::CPAN
my $self = shift( @_ );
my $q = $self->_reset_query;
return( $q->returning( @_ ) );
}
sub rollback
{
return( shift->{dbh}->rollback() );
}
sub rollback_to(@)
{
return( shift->{dbh}->pg_rollback_to( @_ ) );
}
sub savepoint(@)
{
return( shift->{dbh}->pg_savepoint( @_ ) );
}
sub schema { return( shift->_set_get_scalar( 'schema', @_ ) ); }
sub search_path
{
my $self = shift( @_ );
if( @_ )
lib/DB/Object/Postgres.pm view on Meta::CPAN
my $all = $sth->fetchall_arrayref( {} );
return( $all );
}
# See DB::Object
# sub tables_refresh
# See DB::Object
# sub tie
sub trace($;@)
{
my $self = shift( @_ );
# Value is a numeric level; see parse_trace_flag.
return( $self->error( "Trace can only be used on active connection. Use connect first." ) ) if( !$self->{dbh} );
if( @_ )
{
# my( $opt, $filename ) = @_;
$self->{dbh}->trace( @_ );
}
return( $self->{dbh}->trace );
}
sub trace_msg(@)
{
my $self = shift( @_ );
return( $self->error( "Trace can only be used on active connection. Use connect first." ) ) if( !$self->{dbh} );
# $dbh->trace_msg( $message_text, $min_level );
return( $self->{dbh}->trace_msg( @_ ) );
}
# sub unix_timestamp
sub unlock
lib/DB/Object/SQLite.pm view on Meta::CPAN
return( $self );
}
# Get/set alias
# sub alias
# sub as_string
# sub avoid
sub attribute($;$@)
{
my $self = shift( @_ );
# $h->{AttributeName} = ...; # set/write
# ... = $h->{AttributeName}; # get/read
# 1 means that the attribute may be modified
# 0 mneas that the attribute may only be read
my $name = shift( @_ ) if( @_ == 1 );
my %arg = ( @_ );
my %attr =
(
lib/DB/Object/SQLite.pm view on Meta::CPAN
$attr{ $name } )
{
$self->{dbh}->{ $name } = $value;
}
}
}
}
# sub available_drivers(@)
sub begin_work($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 1;
return( $self->{dbh}->begin_work( @_ ) );
}
# This method is common to DB::Object and DB::Object::Statement
# sub bind
# sub cache
sub can_update_delete_limit { return( shift->has_compile_option( 'ENABLE_UPDATE_DELETE_LIMIT' ) ); }
# sub check_driver(@;$@)
sub commit($;$@)
{
my $self = shift( @_ );
$self->{transaction} = 0;
return( $self->{dbh}->commit( @_ ) );
}
sub compile_options
{
my $self = shift( @_ );
return( [ @$COMPILE_OPTIONS ] ) if( scalar( @$COMPILE_OPTIONS ) );
lib/DB/Object/Statement.pm view on Meta::CPAN
}
sub executed
{
my $self = shift( @_ );
# For hand made query to avoid clash when executing generic routine such as fetchall_arrayref...
return( 1 ) if( !exists( $self->{query} ) );
return( exists( $self->{executed} ) && $self->{executed} );
}
sub fetchall_arrayref($@)
{
my $self = shift( @_ );
my $slice = shift( @_ ) || [];
my $dbo = $self->database_object;
my $sth = $self->{sth};
if( !$self->executed() )
{
$self->execute() || return;
}
# Ensure we set the cache of field names and types. We will need them to post process the query results with _convert_datetime2object()
lib/DB/Object/Statement.pm view on Meta::CPAN
warn( "fetchall_arrayref($mode) invalid" );
}
# return( \@rows );
return( \@rows ) if( !$need_post_processing );
my $data = \@rows;
$data = $self->_convert_json2hash({ statement => $sth, data => $data }) if( $dbo->auto_decode_json );
$data = $self->_convert_datetime2object({ statement => $sth, data => $data }) if( $dbo->auto_convert_datetime_to_object );
return( $data );
}
sub fetchcol($;$)
{
my $self = shift( @_ );
# @arr = $sth->fetchcol( $col_number );
my $col_num = shift( @_ );
if( !$self->executed() )
{
$self->execute() || return( $self->pass_error );
}
# $self->_cleanup();
# return( $h->fetchcol( $COL_NUM ) );
my @col;
# $self->dataseek( 0 );
my $ref;
while( $ref = $self->{sth}->fetchrow_arrayref() )
{
push( @col, $ref->[ $col_num ] );
}
return( @col );
}
sub fetchhash(@)
{
my $self = shift( @_ );
my $dbo = $self->database_object;
if( !$self->executed() )
{
$self->execute() || return( $self->pass_error );
}
# Ensure we set the cache of field names and types. We will need them to post process the query results with _convert_datetime2object()
# This is necessary for MySQL whose object lose that information, while the PostgreSQL or SQLite driver keep the information.
if( $dbo->auto_decode_json || $dbo->auto_convert_datetime_to_object )
lib/DB/Object/Statement.pm view on Meta::CPAN
$ref = $self->_convert_datetime2object({ statement => $sth, data => $ref }) if( $dbo->auto_convert_datetime_to_object );
}
return( %$ref );
}
else
{
return( () );
}
}
sub fetchrow(@)
{
my $self = shift( @_ );
if( !$self->executed() )
{
$self->execute() || return( $self->pass_error );
}
# $self->_cleanup();
# @arr = $sth->fetchrow; # Array context
# $firstcol = $sth->fetchrow; # Scalar context
# return( $h->fetchrow );
lib/DB/Object/Statement.pm view on Meta::CPAN
my $self = shift( @_ );
if( $self->{sth} && $self->param( 'autocommit' ) )
{
my $sth = $self->prepare( "ROLLBACK" ) || return( $self->error( "An error occurred while preparing query to rollback: ", $self->error ) );
$sth->execute() || return( $self->error( "Error occurred while executing query to rollback: ", $sth->error ) );
$sth->finish();
}
return( $self );
}
sub rows(@)
{
my $self = shift( @_ );
if( !$self->executed() )
{
$self->execute() || return( $self->pass_error );
}
# $self->_cleanup();
# $rv = $sth->rows;
if( !ref( $self ) )
{
lib/DB/Object/Tables.pm view on Meta::CPAN
$o->prefixed( $self->{prefixed} );
$self->messagec( 5, "Saving fields object whose table object has name {green}", $o->table_object->name, "{/} and alias {green}", $o->table_object->as, "{/}. Fields object has debug value '", $o->debug, "'" );
$self->{fields_object} = $o;
return( $o );
}
sub fo { return( shift->fields_object( @_ ) ); }
sub foreign { return( shift->_set_get_hash_as_mix_object( 'foreign', @_ ) ); }
sub format_statement($;\%\%@) { return( shift->_method_to_query( 'format_statement', @_ ) ); }
sub format_update($;%) { return( shift->_method_to_query( 'format_update', @_ ) ); }
sub from_unixtime { return( shift->_method_to_query( 'from_unixtime', @_ ) ); }
sub get_query_object { return( shift->_reset_query ); }
sub group { return( shift->_method_to_query( 'group', @_ ) ); }
# sub indexes { return( shift->_set_get_class_array_object( 'indexes', {
# is_primary => { type => 'boolean' },
# is_unique => { type => 'boolean' },