• Files
• Commits
• Log
• Graph
• Stats

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;

use lib '/home/raj/perl-lib';
use Local::Utils; # dump_query

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("\0", @bind), ")\n"; # matches local RDB ::Object & ::Manager
    }

    $self->SUPER::query($query, @bind);
}

sub dump_query { Local::Utils::dump_query(@_) }

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;