• Files
• Commits
• Log
• Graph
• Stats

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;

# just returns dsn as array:
sub dsn {
    my ($class, $args) = @_;
	my @dsn = _mysql_connection_params($args); # warn Dumper \@dsn;
	return @dsn;
}

our %DBIx_Simple_Cache; # so DBIx::Simple object can be shared

sub dbix { # provides overloaded query() & _mysql_connection_params()
	my ($class, $args) = @_;

	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:
	$DBIx_Simple_Cache{$db_name} ||= $class->_new_dbix_simple($args);
}

sub _new_dbix_simple {
	my ($class, $args) = @_;

	my @dsn = _mysql_connection_params($args);
=begin # causes "mysql has gone away" error every request after 1 query execution:
	my $dbc = DBIx::Connector->new(@dsn); # ddp $db;
	my $dbix = $class->SUPER::new($dbc->dbh); # ddp $dbix; # SUPER is DBIx::Simple
=cut
	my $dbix = $class->SUPER::connect(@dsn); # ddp $dbix; # SUPER is DBIx::Simple
}

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/(\,)(?!\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 $str = sprintf "%s\n[%s]", $query, join ', ',
			# truncate long @bind elements at 100 chars:
			join ', ', 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';

	my %args = (
		PrintError => 0, 
		RaiseError => 1, 
		mysql_auto_reconnect => 0,
	);
    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, \%args );
}

1;