App-Repository
view release on metacpan or search on metacpan
Other stuff
o implement high(er) availability, load balancing, read/write database handles
o caching rows by key
o caching row-sets by set-key
o DBI - refactored/unified params/cols/values handling
- arbitrarily complex where clauses
o auto-history (audit trail) on a table
o DBI - auto-reconnect on all operations
o DBI - bind variables on all operations
o all - benchmarks
o Remote - make a remote repository work
o all - get related rows (relationships)
o all - $rep->set_rows(...) - make work with %$params
o MySQL - Shared connections between repositories
o File
o all - $rep->purge(...)
o MySQL - $rep->purge(...)
lib/App/Repository/DBI.pm view on Meta::CPAN
if (!$columns || ref($columns) ne "ARRAY") {
$columns = [];
}
&App::sub_exit($columns) if ($App::trace);
return($columns);
}
# modified from the DBD::_::db::selectall_arrayref in DBI.pm
sub _selectrange_arrayref {
&App::sub_entry if ($App::trace);
my ($self, $stmt, $startrow, $endrow, $attr, @bind) = @_;
my $dbh = $self->{dbh};
return [] if (!$dbh);
my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
if ($sth) {
$sth->execute(@bind) || return;
my $slice = $attr->{Slice}; # typically undef, else hash or array ref
if (!$slice and $slice=$attr->{Columns}) {
if (ref $slice eq 'ARRAY') { # map col idx to perl array idx
$slice = [ @{$attr->{Columns}} ]; # take a copy
for (@$slice) { $_-- }
}
}
my $retval = $self->_fetchrange_arrayref($sth, $startrow, $endrow, $slice);
&App::sub_exit($retval) if ($App::trace);
return($retval);
lib/App/Repository/DBI.pm view on Meta::CPAN
&App::sub_exit($sql) if ($App::trace);
$sql;
}
######################################################################
# SIMPLE SQL OPERATIONS
######################################################################
# $row = $rep->select_row ($table, \@cols, \@params, \%paramvalues);
# this is a new version that uses bind variables instead of relying on my quoting rules
# unfortunately, it doesn't work yet
sub _select_row {
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $params, $paramvalues) = @_;
my ($dbh, $sql, $param, @params, %paramvalues, @paramvalues);
$self->{error} = "";
if (defined $params) {
lib/App/Repository/DBI.pm view on Meta::CPAN
}
# NOTE: everything after the first line is optional
# @rows = $rep->_select_rows($table, \@cols,
# \@params, \%paramvalues, \@order_by,
# $startrow, $endrow,
# \@sortdircol, \@keycolidx, \@writeable, \@columntype, \@summarykeys);
# TODO: get the $startrow/$endrow working when one/both/neither work in the SQL portion
# TODO: rethink $startrow/$endrow vs. $numrows/$skiprows
# this is a new version that uses bind variables instead of relying on my quoting rules
# unfortunately, it doesn't work yet
sub _select_rows {
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $params, $paramvalues, $order_by, $startrow, $endrow,
$sortdircol, $keycolidx, $writeable, $columntype, $group_by) = @_;
my ($sql, $param, @params, %paramvalues, @paramvalues);
$self->{error} = "";
lib/App/Repository/DBI.pm view on Meta::CPAN
my $dbh = $self->{dbh};
my $retval = 0;
my $context_options = $self->{context}{options};
my $debug_sql = $context_options->{debug_sql};
my ($timer, $elapsed_time);
my $loglevel = 1;
if ($debug_sql) {
$timer = $self->_get_timer();
print $App::DEBUG_FILE "DEBUG_SQL: insert()\n";
print $App::DEBUG_FILE "DEBUG_SQL: bind vars [", join("|",map { defined $_ ? $_ : "undef" } @$row), "]\n";
print $App::DEBUG_FILE $sql;
}
if ($context_options->{explain_sql}) {
$self->explain_sql($sql);
}
if (defined $dbh) {
eval {
### TODO: make this work with regex for retry
$retval = $dbh->do($sql, undef, @$row);
$retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
};
if ($@) { # Log the error message with the SQL and rethrow the exception
my $bind_values = join("|", map { defined $_ ? $_ : "undef" } @$row);
$loglevel = 3 if ($@ =~ /duplicate/i);
$self->{context}->log({level=>$loglevel}, "DBI Exception (fail) in _insert_row(): $@BIND VALUES: [$bind_values]\nSQL: $sql");
die $@;
}
}
if ($debug_sql) {
$elapsed_time = $self->_read_timer($timer);
print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] ($elapsed_time sec) $DBI::errstr\n";
print $App::DEBUG_FILE "\n";
}
&App::sub_exit($retval) if ($App::trace);
lib/App/Repository/DBI.pm view on Meta::CPAN
my ($timer, $elapsed_time);
my $loglevel = 1;
if ($debug_sql) {
$timer = $self->_get_timer();
}
if (ref($rows) eq "ARRAY") {
$sql = $self->_mk_insert_row_sql($table, $cols);
foreach my $row (@$rows) {
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: _insert_rows()\n";
print $App::DEBUG_FILE "DEBUG_SQL: bind vars [", join("|",map { defined $_ ? $_ : "undef" } @$row), "]\n";
print $App::DEBUG_FILE $sql;
}
if ($explain_sql) {
$self->explain_sql($sql);
}
if (defined $dbh) {
eval {
### TODO: make this work with regex for retry
$retval = $dbh->do($sql, undef, @$row);
$retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
};
if ($@) { # Log the error message with the SQL and rethrow the exception
$loglevel = ($@ =~ /duplicate/i) ? 3 : 1;
my $bind_values = join("|", map { defined $_ ? $_ : "undef" } @$row);
$self->{context}->log({level=>$loglevel}, "DBI Exception (fail) in _insert_rows() [ARRAY]: $@BIND VALUES: [$bind_values]\nSQL: $sql");
die $@;
}
}
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
print $App::DEBUG_FILE "\n";
}
if ($retval) {
$nrows ++;
lib/App/Repository/DBI.pm view on Meta::CPAN
$rows = []; # we will be refilling this buffer
my %options = ( %$options ); # make a copy so it can be modified
$options->{maxrows} = 100;
$sql = $self->_mk_insert_row_sql($table, $cols);
while (1) {
$rows = $self->_read_rows_from_file($fh, $cols, \%options);
last if ($#$rows == -1);
foreach my $row (@$rows) {
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: _insert_rows()\n";
print $App::DEBUG_FILE "DEBUG_SQL: bind vars [", join("|",map { defined $_ ? $_ : "undef" } @$row), "]\n";
print $App::DEBUG_FILE $sql;
}
if ($context_options->{explain_sql}) {
$self->explain_sql($sql);
}
if (defined $dbh) {
eval {
### TODO: make this work with regex for retry
$retval = $dbh->do($sql, undef, @$row);
$retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
};
if ($@) { # Log the error message with the SQL and rethrow the exception
$loglevel = ($@ =~ /duplicate/i) ? 3 : 1;
my $bind_values = join("|", map { defined $_ ? $_ : "undef" } @$row);
$self->{context}->log({level=>$loglevel}, "DBI Exception (fail) in _insert_rows() [FILE]: $@BIND VALUES: [$bind_values]\nSQL: $sql");
die $@;
}
}
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
print $App::DEBUG_FILE "\n";
}
if ($retval) {
$nrows ++;
lib/App/Repository/DBI.pm view on Meta::CPAN
$param_direction = $param_option || "IN";
$param_length = 100;
$param_type = undef;
}
else {
$param_direction = $param_option->{direction} || "IN";
$param_length = $param_option->{length} || 100;
$param_type = $param_option;
}
if ($param_direction eq "OUT") {
$sth->bind_param_inout($i+1, \$_[$i+4], $param_length);
}
elsif ($param_direction eq "INOUT") {
$sth->bind_param_inout($i+1, \$_[$i+4], $param_length);
}
else {
$sth->bind_param($i+1, $params[$i], $param_type);
}
}
$sth->execute();
my (@values);
my $rows = [];
if (defined $return_type) {
while (@values = $sth->fetchrow_array()) {
push(@$rows, [@values]);
}
if ($return_type eq "LIST") {
t/DBI-select.t view on Meta::CPAN
is($sql, $expect_sql, "_mk_select_sql(): key (again)");
&check_select($sql,0);
$expect_sql = <<EOF;
select
age
from test_person
where person_id is null
EOF
$sql = $rep->_mk_select_sql("test_person",undef,"age");
is($sql, $expect_sql, "_mk_select_sql(): by key (bind vars)");
&check_select($sql,0);
$expect_sql = <<EOF;
select
age
from test_person
where age = 37
EOF
$sql = $rep->_mk_select_sql("test_person",{age => 37},"age");
is($sql, $expect_sql, "_mk_select_sql(): param");
t/DBI-select.t view on Meta::CPAN
where first_name is null
and age is null
and birth_dt is null
EOF
$sql = $rep->_mk_select_sql("test_person",{
"_order" => [ "first_name", "age", "birth_dt", ],
"first_name" => undef,
"age" => undef,
"birth_dt" => undef,
},["first_name"]);
is($sql, $expect_sql, "_mk_select_sql(): params (bind vars)");
&check_select($sql,0);
$expect_sql = <<EOF;
select
first_name
from test_person
where first_name in ('stephen','paul')
and age in (37,39)
and birth_dt in ('1962-01-01','1963-12-31')
EOF
t/DBI-select.t view on Meta::CPAN
EOF
&test_get_rows($expect_sql,0,"_mk_select_joined_sql(): key","test_person",1,"age");
#$expect_sql = <<EOF;
#select
# t1.age cn13
#from
# test_person t1
#where t1.person_id is null
#EOF
#&test_get_rows($expect_sql,0,"_mk_select_joined_sql(): by key (bind vars)","test_person",undef,"age");
$expect_sql = <<EOF;
select
t1.age cn13
from
test_person t1
where t1.age = 37
EOF
&test_get_rows($expect_sql,0,"_mk_select_joined_sql(): param","test_person",{age => 37},"age");
t/DBI-select.t view on Meta::CPAN
$expect_sql = <<EOF;
select
t1.first_name cn1
from
test_person t1
where t1.first_name is null
and t1.age is null
and t1.birth_dt is null
EOF
&test_get_rows($expect_sql, 0, "_mk_select_joined_sql(): params (bind vars)",
"test_person",{
"_order" => [ "first_name", "age", "birth_dt", ],
"first_name" => undef,
"age" => undef,
"birth_dt" => undef,
},["first_name"]);
$expect_sql = <<EOF;
select
t1.first_name cn1
( run in 0.934 second using v1.01-cache-2.11-cpan-2398b32b56e )