package LIMS::Local::DBIxSimple; =begin #=============================================================================== sub-classes DBIx::Simple to: a) dump query statements to output b) allow omniplaceholders (??) in same query as placeholders (?) #=============================================================================== =cut use strict; use warnings; use parent 'DBIx::Simple'; use Data::Dump qw(dump); use Data::Dumper; use Scalar::Util; sub query { my $self = shift; 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/(FROM)(?!\n)/\n$1\n /g; $query =~ s/(WHERE)(?!\n)/\n$1\n /g; # SORT|(GROUP BY)/ $query =~ s/\t/ /g; # leading tab -> 2 spaces } if ( $ENV{RDBO_DEBUG} ) { no warnings 'uninitialized'; # common for @bind params to be undef warn "$query (", join(', ', @bind), ")\n"; # modified from RDBO } $self->SUPER::query($query, @bind); } sub dump_query { # might need to use _replace_omniholder(below) if sql contains '??' my ($self, $sql, @bind) = @_; for my $val (@bind) { # replace each '?' with next element of array: $val = $self->dbh->quote($val) # quote anything other than numbers unless Scalar::Util::looks_like_number($val); # say $val; $sql =~ s/\Q?/$val/; } $sql =~ s/(FROM|INNER|WHERE|ORDER BY|GROUP BY)/\n$1/g; $sql =~ s{\) (OR \()}{\n\t\( $1}g; # print_run.pl query $sql =~ s/(AND)/\n\t$1/g; print '=' x 80, "\n"; print $sql, "\n"; print '=' x 80, "\n"; } sub _replace_omniholder { my ($self, $query, $binds) = @_; # warn dump [$query, $binds]; # scalarref, arrayref return if $$query !~ /\(\?\?\)/; #------------------------------------------------------------------------------- # count how many individual placeholders in query for subtraction from @$binds: my $re = qr{ \?}; # 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; } =begin # sql already output in $dbix update/insert/delete functions ?? how sub delete { my $self = shift; my $table = shift; # scalar my $args = shift; # hashref my @args = map { "$_ = $args->{$_}" } keys %$args; my $statement = sprintf qq!DELETE FROM $table\nWHERE %s\n!, join ' AND ', @args; warn $statement; $self->SUPER::delete($table, $args); } sub insert { my $self = shift; my $table = shift; # scalar my $args = shift; # hashref my $cols = join ', ', keys %$args; my $vals = join ', ', values %$args; my $statement = sprintf qq!INSERT INTO $table (%s)\nVALUES (%s)\n!, $cols, $vals; warn $statement; $self->SUPER::insert($table, $args); } sub update { my $self = shift; my $table = shift; # scalar my $vals = shift; # hashref my $args = shift; # hashref (optional) my @vals = map { "$_ = $vals->{$_}" } keys %$vals; my @args = map { "$_ = $args->{$_}" } keys %$args; my $statement = sprintf qq!UPDATE $table\nSET %s\n!, join ', ', @vals; if (@args) { $statement .= sprintf q!WHERE %s\n!, join ' AND ', @args; } warn $statement; $self->SUPER::update($table, $vals, $args); } =cut 1;