package Local::DB;
=begin # README ================================================================
wrapper around DBIx::Simple providing overloaded query() and _replace_omniholder()
uses Term::ANSIColor to colour-code query output to console
methods to:
* dump query statements to output
* allow omniplaceholders (??) in same query as placeholders (?)
usage: my $o = Local::DB->dbix('db_name'), then call DBIx::Simple methods on $o
=cut #==========================================================================
use parent 'DBIx::Simple';
# use DBIx::Connector;
use Term::ANSIColor;
use Data::Printer alias => 'ddp';
use Data::Dumper;
use Modern::Perl;
use Local::Utils;
our %DBIx_Simple_Cache; # so DBIx::Simple object can be shared
sub debug { ddp @_ }
# just returns dsn as array:
sub dsn {
my ($class, $args) = @_;
my @dsn = _mysql_connection_params($args); # warn Dumper \@dsn;
return @dsn;
}
sub dbix { # provides overloaded query() & _mysql_connection_params()
my ($class, $args) = @_;
my $time_now = Local::Utils::time_now;
my @caller = caller(1); # ddp @caller;
my $caller = $caller[3];
my $db_name =
( ref $args eq 'HASH' && $args->{dsn} )
? $args->{dsn} # eg 'dbi:SQLite:dbname=:memory:'
: $args; # eg 'hilis4'
# returned cached object, or create new & return it:
=begin # this doesn't work for long-running dbix objects in case db disconnects
# $DBIx_Simple_Cache{$db_name} ||= $class->_new_dbix_simple($args);
=cut # replaced with:
if ( my $dbix = $DBIx_Simple_Cache{$db_name} ) {
my $id = $dbix->dbh->{mysql_thread_id};
# return $dbix if $dbix->dbh->ping;
if ( $dbix->dbh->ping ) { # only return cached dbix if dbh still active:
my $s = "$time_now active dbh (thread_id=$id) so returning cached dbix for $caller";
ddp $s;
return $dbix;
}
my $s = "$time_now have cached dbix for $caller but dbh INACTIVE (thread_id=$id)";
ddp $s;
}
# so either no $DBIx_Simple_Cache{$db_name} or dbh didn't respond to ping so
# create a new one and return it:
my $new_dbix = $class->_new_dbix_simple($args);
my $id = $new_dbix->dbh->{mysql_thread_id};
my $s = "$time_now creating new dbix object for $caller (thread_id=$id)"; ddp $s;
$DBIx_Simple_Cache{$db_name} = $new_dbix;
return $new_dbix;
}
sub _new_dbix_simple {
my ($class, $args) = @_;
my @dsn = _mysql_connection_params($args);
my $dbix = $class->SUPER::connect(@dsn); # ddp $dbix; # SUPER is DBIx::Simple
=begin # generates mysql gone away error:
my $dbc = DBIx::Connector->new(@dsn); # ddp $dbc;
my $dbix = $class->SUPER::new($dbc->dbh); # ddp $dbix; # SUPER is DBIx::Simple
=cut
}
sub query {
my $self = shift; # ddp $self;
my $query = shift; # warn $query;
my @bind = @_; # warn Dumper \@bind;
# try to emulate output of Rose::DB::Object::QueryBuilder :
{
my $key_words = join '|',
qw(select from where join date_sub curdate interval show columns);
$query =~ s/\b($key_words)\b/uc $1/eg;
$query =~ s/(SELECT)(?!\n)/$1\n /;
$query =~ s/(\,)(?!\n)/$1\n /g; # commas in SELECT list
$query =~ s/(FROM)(?!\n)/\n$1\n /;
$query =~ s/((INNER|LEFT OUTER)\s?JOIN)(?!\n)/\n\t $1/g;
$query =~ s/(WHERE)(?!\n)/\n$1\n /;
$query =~ s/(ORDER BY)(?!\n)/\n$1\n /;
$query =~ s/(GROUP BY)(?!\n)/\n$1\n /;
$query =~ s/\t/ /g; # tabs -> 2 spaces
}
if ( grep $ENV{$_}, qw/RDBO_DEBUG SQL_TRACE/ ) {
no warnings 'uninitialized'; # common for @bind params to be undef
my $divider = '-' x 70;
my $thread_id = $self->dbh->{mysql_thread_id};
my $str = sprintf "[%s] %s\n[%s]", $thread_id, $query, join ', ',
# truncate long @bind elements at 100 chars:
map { length($_) > 103 ? substr($_, 100).'...' : $_ } @bind;
print STDERR $divider, "\n";
print STDERR color('yellow');
print STDERR $str, "\n";
print STDERR color('reset'); # ie color('white');
print STDERR $divider, "\n\n";
}
$self->SUPER::query($query, @bind);
}
sub _replace_omniholder {
my ($self, $query, $binds) = @_; # say dump [$query, $binds]; # scalarref, arrayref
return if $$query !~ /\(\?\?\)/;
#-------------------------------------------------------------------------------
# count how many individual placeholders in query for subtraction from @$binds:
my $re = qr{\s\?}; # ie individual placeholders - WHERE foo = ? AND bar = ?
# $placeholders_count++ while $$query =~ /$re/g; # warn $placeholders_count;
my $placeholders_count = () = $$query =~ /$re/g; # warn $placeholders_count; # perlfaq4
my $omniholders_count = scalar(@$binds) - $placeholders_count;
#-------------------------------------------------------------------------------
my $omniholders = 0;
#-------------------------------------------------------------------------------
# global vars copied from DBIx::Simple - only used in this sub anyway:
my $quoted = qr/(?:'[^']*'|"[^"]*")*/; # 'foo''bar' simply matches the (?:) twice
my $quoted_mysql = qr/(?:(?:[^\\']*(?:\\.[^\\']*)*)'|"(?:[^\\"]*(?:\\.[^\\"]*)*)")*/;
#-------------------------------------------------------------------------------
my $q = $self->{dbd} =~ /mysql/ ? $quoted_mysql : $quoted; # warn $q;
$$query =~ s[($q|\(\?\?\))] {
$1 eq '(??)'
? do {
Carp::croak('There can be only one omniholder') if $omniholders++; # warn $1;
#-------------------------------------------------------------------------------
# '(' . join(', ', ('?') x @$binds) . ')'
'(' . join(', ', ('?') x $omniholders_count) . ')' # adjusted bind count
#-------------------------------------------------------------------------------
}
: $1
}eg; # warn dump $query;
}
sub _mysql_connection_params {
my $args = shift; # can be db name (str) or href eg dsn => dbi:SQLite:dbname=<db>
my $cnf = '/home/raj/.local/mysql.cnf';
-f $cnf || die 'no mysql.cnf file found';
my %attr = (
PrintError => 0,
RaiseError => 1,
mysql_auto_reconnect => 0, # used in conjunction with testing for ping
);
return ( ref $args eq 'HASH' && $args->{dsn} )
? $args->{dsn} # just return dsn if configured (eg SQLite doesn't need username/pwd)
: ( "dbi:mysql:host=localhost;database=$args;mysql_read_default_file=$cnf",
undef, undef, \%attr );
}
1;
