package Local::DB; =begin # README ================================================================================ wrapper around DBIx::Simple providing overloaded query() and _replace_omniholder() * dumps query statements to stdout using Term::ANSIColor to colour-code * logs queries using Local::QueryLogger - requires log_query => 1 in call to dbix() * auto-inflates dates (unless switched off in caller with $Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 1) * allows omniplaceholders (??) in same query as placeholders (?) usage: my $o = Local::DB->dbix(\%args), then call DBIx::Simple methods on $o ================================================================================ =cut use parent 'DBIx::Simple'; use DBIx::Simple::OO; # allows call to ->objects use Local::DBIx::Simple::Result; # sub-classes DBIx::Simple::Result to auto-inflate dates use Module::Runtime qw(use_module); use Scalar::Util 'looks_like_number'; use Data::Printer alias => 'ddp'; use SQL::Abstract::More; use Data::Dumper; use Modern::Perl; use Local::Utils; use Local::QueryLogger; sub query_logger { $_[0]->{logger} ||= $_[0]->_build_query_logger(@_) } sub _build_query_logger { Local::QueryLogger->new(@_) } sub sqlam { $_[0]->{_sqlam} ||= $_[0]->_build_sqlam } sub _build_sqlam { SQL::Abstract::More->new } our %DBIx_Simple_Cache; # so DBIx::Simple object can be shared # flag to write queries to logfile, initially set by ENV param, default off, # maybe overridden by 'log_query' arg passed in call to dbix(): my $USE_LOG_FILE = $ENV{LOG_QUERIES} || 0; # warn $USE_LOG_FILE; 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 query { # inherits from parent, logs query to console and/or log file my $self = shift; # ddp $self; my ($str, @bind) = @_; # warn $str; warn Dumper \@bind; # do querylog functions (log to file if required): $self->query_logger(use_log_file => $USE_LOG_FILE)->log_query($str, @bind); # continue on its original way: $self->SUPER::query($str, @bind); } sub count { my ($self, $table, $where) = @_; # ddp $table; ddp $where; my @args = ($table, ['COUNT(*)']); push @args, $where if $where; my $count = $self->select(@args)->list; return $count; } sub sam_query { # combines SQL::Abstract::More & DBIx query: my ($self, $ref, $q) = @_; # SQLAM args (cols, rels, where, etc), optional flag to dump_query my @args = ( -columns => $ref->{cols}, -from => [ -join => @{ $ref->{rels} } ], -where => $ref->{where}, ); push @args, ( -order_by => $ref->{sort_by} ) if $ref->{sort_by}; # p @args; my ($sql, @bind) = $self->sqlam->select(@args); # p $sql; p \@bind; $self->dump_query($sql, @bind) if $q; return $self->query($sql, @bind); } sub get_cols { my ($self, $tbl) = @_; my @data = $self->query('SHOW COLUMNS FROM ' . $tbl)->hashes; my @cols = map $_->{Field}, @data; return wantarray ? @cols : \@cols; } sub dbix { # provides overloaded query() & _mysql_connection_params() my ($class, $ref) = @_; # href of username & (db or dsn) # either db_name or dsn eg (dbi:SQLite:dbname=:memory:) my $db = $ref->{dsn} || $ref->{dbname} || die 'no dsn or db name'; # write query to logfiles (don't override if already set by $ENV{LOG_QUERIES}): $USE_LOG_FILE ||= $ref->{log_query}; # this doesn't work for long-running dbix objects in case db disconnects: # $DBIx_Simple_Cache{$db_name} ||= $class->_new_dbix_simple($args); replaced with: #=begin # non-debugging version: # returned cached object if dbh still active, or create new & return it: if ( my $dbix = $DBIx_Simple_Cache{$db} ) { return $dbix if $dbix->dbh->ping; # only return cached dbix if dbh still active } # so either no $DBIx_Simple_Cache{$db_name} or dbh didn't respond to ping so # create a new one and return it: return $DBIx_Simple_Cache{$db} = $class->_new_dbix_simple($ref); #=cut # debugging variant of above =================================================== my $time_now = Local::Utils::time_now; my @caller = caller(1); # ddp @caller; my $caller = $caller[3]; # ddp $caller; # needs adjusting if called from a .pl script ?? if ( my $dbix = $DBIx_Simple_Cache{$db} ) { 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: say "$time_now active dbh (thread_id=$id) so returning cached dbix for $caller"; return $dbix; } say "$time_now have cached dbix for $caller but dbh INACTIVE (thread_id=$id)"; } # 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($ref); my $id = $new_dbix->dbh->{mysql_thread_id}; say "$time_now creating new dbix object for $caller (thread_id=$id)"; $DBIx_Simple_Cache{$db} = $new_dbix; return $new_dbix; #=============================================================================== } sub dump_query { Local::Utils::dump_query(@_) } sub update_or_insert { my ($self, $table, $data) = @_; # ddp [$table, $data]; # str, href my $odku = $_[3] # aref or die 'require a list of cols to provide to ON DUPLICATE KEY UPDATE'; my ($sql, @bind) = $self->sqlam->insert($table, $data); # ddp @bind; $sql .= ' ON DUPLICATE KEY UPDATE ' . join ', ', map { "`$_`=VALUES(`$_`)" } @$odku; # say $sql; return; my $result = $self->query($sql, @bind); return $result; } sub insert_or_update_if_greater { my ($self, $table, $data) = @_; # str, href my $col = $_[3] # scalar or die 'require one column to provide to ON DUPLICATE KEY UPDATE'; my ($sql, @bind) = $self->sqlam->insert($table, $data); # ddp @bind; $sql .= qq! ON DUPLICATE KEY UPDATE $col = IF(VALUES($col) > $col, VALUES($col), $col)!; # say $sql; return; my $result = $self->query($sql, @bind); return $result; } 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 # replace default dbix result_class (DBIx::Simple::Result) with # Local::DBIx::Simple::Result (provides auto-date-inflation): $dbix->{result_class} = use_module('Local::DBIx::Simple::Result'); =begin # generates mysql gone away error: use DBIx::Connector; my $dbc = DBIx::Connector->new(@dsn); # ddp $dbc; my $dbix = $class->SUPER::new($dbc->dbh); # ddp $dbix; # SUPER is DBIx::Simple =cut =begin # integrated Log4perl dbh: my $dbh = _log4perl_dbh(@dsn); my $dbix = $class->SUPER::new($dbh); # ddp $dbix; # SUPER is DBIx::Simple =cut return $dbix; } =begin # integrated Log4perl dbh: sub _log4perl_dbh { # uncomment dbix_l4p_logmask in _mysql_connection_params() use Log::Log4perl; use DBIx::Log4perl qw(:masks); Log::Log4perl->init("/path/to/mylog4perl.conf"); return DBIx::Log4perl->connect(@_); # dbh; } =cut sub _mysql_connection_params { my $args = shift; # href of username & (db or dsn eg dbi:SQLite:dbname=) # just return dsn if configured (eg SQLite doesn't need username/pwd) return $args->{dsn} if $args->{dsn}; my $cnf = '/home/raj/.local/mysql.cnf'; -f $cnf || die 'no mysql.cnf file found'; my $dbname = $args->{dbname}; my $host = $args->{port} ? '127.0.0.1' : 'localhost'; my $port = $args->{port} || 3306; # optional, need to specify host=127.0.0.1 if used my $dsn = join ';', ( 'dbi:mysql:host='.$host, 'database='.$dbname, 'port='.$port , 'mysql_read_default_file='.$cnf ); # ddp $dsn; my %attr = ( PrintError => 0, RaiseError => 1, mysql_auto_reconnect => 0, # used in conjunction with testing for ping # uncomment if using log4perl dbh: # dbix_l4p_logmask => DBIX_L4P_LOG_SQL|DBIX_L4P_LOG_DELAYBINDPARAM, ); return ( $dsn, undef, undef, \%attr ); } sub _replace_omniholder { my ($self, $query, $binds) = @_; # ddp [$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; # ddp $q; $$query =~ s[($q|\(\?\?\))] { $1 eq '(??)' ? do { Carp::croak('There can be only one omniholder') if $omniholders++; # ddp $1; #------------------------------------------------------------------------------- # '(' . join(', ', ('?') x @$binds) . ')' '(' . join(', ', ('?') x $omniholders_count) . ')' # adjusted bind count #------------------------------------------------------------------------------- } : $1 }eg; # ddp $query; } 1;