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= 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;