[svn:p5ee] r12060 - in p5ee/trunk/App-Repository: lib/App lib/App/Repository t
[email protected] Mon, 10 Nov 2008 15:22:54 -0800 (PST)
| Newsgroups | perl.cvs.p5ee |
|---|---|
| Message-ID | <[email protected]> |
Author: spadkins
Date: Mon Nov 10 15:22:53 2008
New Revision: 12060
Modified:
p5ee/trunk/App-Repository/lib/App/Repository.pm
p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm
p5ee/trunk/App-Repository/lib/App/Repository/MySQL.pm
p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm
p5ee/trunk/App-Repository/t/DBI-compress.t
p5ee/trunk/App-Repository/t/DBI-connect.t
p5ee/trunk/App-Repository/t/DBI-delete.t
p5ee/trunk/App-Repository/t/DBI-expr.t
p5ee/trunk/App-Repository/t/DBI-getset-cache.t
p5ee/trunk/App-Repository/t/DBI-getset-realtable.t
p5ee/trunk/App-Repository/t/DBI-getset.t
p5ee/trunk/App-Repository/t/DBI-import.t
p5ee/trunk/App-Repository/t/DBI-insert.t
p5ee/trunk/App-Repository/t/DBI-metadata.t
p5ee/trunk/App-Repository/t/DBI-repobjectdom.t
p5ee/trunk/App-Repository/t/DBI-repobjects.t
p5ee/trunk/App-Repository/t/DBI-repobjectset.t
p5ee/trunk/App-Repository/t/DBI-select.t
p5ee/trunk/App-Repository/t/DBI-transaction.t
p5ee/trunk/App-Repository/t/DBI-update.t
p5ee/trunk/App-Repository/t/SharedDatastore.t
Log:
Oracle support under development
Modified: p5ee/trunk/App-Repository/lib/App/Repository.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository.pm Mon Nov 10 15:22:53 2008
@@ -2030,8 +2030,8 @@
my $table_def = $self->{table}{$table};
$columns = [];
foreach my $col (@{$table_def->{columns}}) {
- if (exists $hash->{lc($col)}) {
- push(@$columns, lc($col));
+ if (exists $hash->{$col}) {
+ push(@$columns, $col);
}
}
}
@@ -2162,6 +2162,16 @@
# }
#}
}
+ my $alternate_keys = $table_def->{alternate_key};
+ if ($alternate_keys) {
+ #foreach my $alternate_key (@$alternate_keys) {
+ # foreach my $column (@$alternate_key) {
+ # if (!defined $hash->{$column}) {
+ # die "Illegal object value for $table: $column cannot be NULL because it exists in an alternate key";
+ # }
+ # }
+ #}
+ }
&App::sub_exit() if ($App::trace);
}
@@ -2627,6 +2637,7 @@
my ($self, $table, $options) = @_;
my $repname = $self->{table}{$table}{repository};
my $realtable = $self->{table}{$table}{table} || $table;
+
my ($table_def);
if (defined $repname && $repname ne $self->{name}) {
my $rep = $self->{context}->repository($repname);
@@ -2989,6 +3000,7 @@
}
else {
@row = split(/$field_sep/);
+ $row[$#$columns] = undef if ($#row < $#$columns);
}
# TODO: use insert_rows() instead of insert_row()
$self->insert_row($table, $columns, \@row);
@@ -4102,7 +4114,6 @@
=cut
sub _load_rep_metadata_from_source {
- die "_load_rep_metadata_from_source() must be implemented in a subclass";
my ($self) = @_;
}
@@ -4217,7 +4228,6 @@
push(@$columns, $column);
$idx = $#$columns;
$column_def->{idx} = $idx;
- $column_def->{alias} = "c$idx" if (!defined $column_def->{alias});
# we're not hiding physical columns and a native table was defined, so make an entry
if (! $self->{hide_physical}) {
@@ -4284,6 +4294,9 @@
}
}
}
+
+ $self->_load_table_metadata_from_source2($table);
+
&App::sub_exit() if ($App::trace);
}
@@ -4317,6 +4330,10 @@
my ($self, $table) = @_;
}
+sub _load_table_metadata_from_source2 {
+ my ($self, $table) = @_;
+}
+
#############################################################################
# METHODS
#############################################################################
Modified: p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm Mon Nov 10 15:22:53 2008
@@ -5,6 +5,7 @@
use App;
use App::Repository;
+use DBI;
use Carp qw(confess);
@@ -176,13 +177,12 @@
return 1 if (defined $self->{dbh});
- my ($dsn, $attr) = map {$self->$_} qw/_dsn _attr/;
-
while ((!$self->{dbh} || !$self->{dbh}->ping())) {
+ my $dsn = $self->_dsn();
+ my $attr = $self->_attr();
eval {
$self->{dbh} = DBI->connect($dsn, $self->{dbuser}, $self->{dbpass}, $attr);
-
};
if (my $e = $@) {
if ($self->is_retryable_connection_error($e)) {
@@ -382,6 +382,8 @@
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
+ my $context = $self->{context};
+
# we only need the first row
$options = {} if (!$options);
if (! $options->{endrow}) {
@@ -416,8 +418,24 @@
}
### TODO: make this similar to the _connect code, using a regex named retryable_select_error_regex
while (1) {
+ my ($column, %deserializer, $deserializer_name, $serializer);
+ my $column_defs = $self->{table}{$table}{column};
eval {
$row = $dbh->selectrow_arrayref($sql);
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $column = $cols->[$i];
+ $deserializer_name = $column_defs->{$column}{deserializer};
+ if ($deserializer_name) {
+ $serializer = $deserializer{$deserializer_name};
+ if (!$serializer) {
+ $serializer = $context->serializer($deserializer_name);
+ $deserializer{$deserializer_name} = $serializer;
+ }
+ if ($row->[$i] ne "") {
+ $row->[$i] = $serializer->deserialize($row->[$i]);
+ }
+ }
+ }
};
if (my $e = $@) {
$row = undef;
@@ -454,6 +472,8 @@
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
+ my $context = $self->{context};
+
my ($sql, $rows, $startrow, $endrow);
my $table_def = $self->get_table_def($table);
#print $App::DEBUG_FILE "DBI._get_rows : table=[$table] rawaccess=[$table_def->{rawaccess}]\n";
@@ -485,8 +505,26 @@
$self->explain_sql($sql);
}
while (1) {
+ my ($column, %deserializer, $deserializer_name, $serializer);
+ my $column_defs = $self->{table}{$table}{column};
eval {
$rows = $self->_selectrange_arrayref($sql, $startrow, $endrow);
+ foreach my $row (@$rows) {
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $column = $cols->[$i];
+ $deserializer_name = $column_defs->{$column}{deserializer};
+ if ($deserializer_name) {
+ $serializer = $deserializer{$deserializer_name};
+ if (!$serializer) {
+ $serializer = $context->serializer($deserializer_name);
+ $deserializer{$deserializer_name} = $serializer;
+ }
+ if ($row->[$i] ne "") {
+ $row->[$i] = $serializer->deserialize($row->[$i]);
+ }
+ }
+ }
+ }
};
if (my $e = $@) {
$rows = [];
@@ -563,7 +601,7 @@
my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
if ($sth) {
- eval {$sth->execute(@bind)}; if (my $e = $@){use Carp qw(confess); confess "Died on: $stmt because of $e";}
+ eval {$sth->execute(@bind)}; if (my $e = $@) {use Carp qw(confess); confess "Died on: $stmt because of $e"; }
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
@@ -627,30 +665,17 @@
sub _mk_where_clause {
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $options) = @_;
- my ($value,$repop, $sqlop, $column_def, $quoted);
- my ($tabledef, $tabcols, $alias, $dbexpr);
+ my ($value,$rep_op, $sql_op, $column_def, $quoted);
+ my ($table_def, $column_defs, $alias);
my $dbh = $self->{dbh};
- #$tabledef = $self->{table}{$table}; #[[ $self->get_table_def($table, $opt);
- $tabledef = $self->get_table_def($table, $options);
- $alias = $tabledef->{alias};
- $tabcols = $tabledef->{column};
- my %sqlop = (
- "contains" => "like",
- "matches" => "like",
- "not_contains" => "not like",
- "not_matches" => "not like",
- "eq" => "=",
- "ne" => "!=",
- "le" => "<=",
- "lt" => "<",
- "ge" => ">=",
- "gt" => ">",
- "in" => "in",
- "not_in" => "not in",
- );
- my %repop = (
+ $table_def = $self->get_table_def($table, $options);
+ $alias = $table_def->{alias};
+ $column_defs = $table_def->{column};
+
+ # %rep_op : defines the operation implied when a VALUE begins with a certain string
+ my %rep_op = (
"=~" => "contains",
"~" => "contains",
"!~" => "not_contains",
@@ -667,6 +692,22 @@
"!/" => "not_regexp",
);
+ # %sql_op : defines the SQL operator implied by a particular Repository operator
+ my %sql_op = (
+ "contains" => "like",
+ "matches" => "like",
+ "not_contains" => "not like",
+ "not_matches" => "not like",
+ "eq" => "=",
+ "ne" => "!=",
+ "le" => "<=",
+ "lt" => "<",
+ "ge" => ">=",
+ "gt" => ">",
+ "in" => "in",
+ "not_in" => "not in",
+ );
+
$params = {} if (!$params);
my $param_order = $params->{"_order"};
if (!defined $param_order && ref($params) eq "HASH") {
@@ -676,78 +717,83 @@
return wantarray ? () : "";
}
- my @where;
+ my (@where_conditions);
for my $param (@$param_order) {
next if (!defined $param || $param eq "");
my $column = $param;
- $sqlop = "=";
- $repop = "";
+ $sql_op = "=";
+ $rep_op = "";
my $inferred_op = 1;
# check if $column contains an embedded operation, i.e. "name.eq", "name.contains"
if ($param =~ /^(.*)\.([^.]+)$/) {
- $repop = $2;
+ $rep_op = $2;
$inferred_op = 0;
- if ($sqlop{$repop}) {
+ if ($sql_op{$rep_op}) {
$column = $1;
- $sqlop = $sqlop{$repop};
+ $sql_op = $sql_op{$rep_op};
}
}
$value = $params->{$param};
- if (!$repop && $value && $value =~ s/^(=~|~|!~|==|=|!=|!|<=|<|>=|>)//) {
- $repop = $repop{$1};
- $sqlop = $sqlop{$repop};
+
+ if (!$rep_op && $value && $value =~ s/^(=~|~|!~|==|=|!=|!|<=|<|>=|>|=\/|\/|!\/)//) {
+ $rep_op = $rep_op{$1};
+ $sql_op = $sql_op{$rep_op};
$inferred_op = 0 if ($1 eq "==");
}
- if (!$repop && $value && $value =~ /[\*\?]/) {
- $repop = "matches";
- $sqlop = $sqlop{$repop};
+ if (!$rep_op && $value && $value =~ /[\*\?]/) {
+ $rep_op = "matches";
+ $sql_op = $sql_op{$rep_op};
}
- if ($repop eq "verbatim") {
- push(@where, "$params->{$param}");
+ if ($rep_op eq "verbatim") {
+ push(@where_conditions, "$params->{$param}");
next;
}
- $column_def = $tabcols->{$column};
+ $column_def = $column_defs->{$column};
if (!defined $column_def) {
if ($param =~ /^(begin|end)_(.*)/) {
$column = $2;
- $sqlop = {begin=>">=", end=>"<="}->{$1};
+ $sql_op = {begin=>">=", end=>"<="}->{$1};
$inferred_op = 0;
}
- $column_def = $tabcols->{$column};
+ $column_def = $column_defs->{$column};
}
+
#[[ From other copy:
# TODO: Remove comment block
# elsif ($paramdefs && $paramdefs->{$param}) {
# if ($paramdefs->{$param}{criteria}) {
-# push(@criteria_conditions, $self->substitute($paramdefs->{$param}{criteria}, $params));
+# push(@where_conditions, $self->substitute($paramdefs->{$param}{criteria}, $params));
# }
# }
#]]
+
next if (!defined $column_def); # skip if the column is unknown
+ my $dbexpr = $column_def->{dbexpr};
+ my $dbexpr_update = $column_def->{dbexpr_update};
+ my $dbexpr_update_applied = 0;
+
if (! defined $value) {
# $value = "?";
# TODO: make this work with the "contains/matches" operators
- if (!$sqlop || $sqlop eq "=") {
- push(@where, "$column is null");
+ if ($options->{no_aliases}) {
+ $dbexpr = $column;
}
- elsif ($sqlop eq "!=") {
- push(@where, "$column is not null");
+ if (!$sql_op || $sql_op eq "=") {
+ push(@where_conditions, "$dbexpr is null");
+ }
+ elsif ($sql_op eq "!=") {
+ push(@where_conditions, "$dbexpr is not null");
}
next;
}
-#Adding: [[
-# TODO: Remove comment block
-#
-# next if (defined $table_def->{param}{$param}{all_value} &&
-# $value eq $table_def->{param}{$param}{all_value});
-#
-#]]
+ next if (defined $table_def->{param}{$param}{all_value} &&
+ $value eq $table_def->{param}{$param}{all_value});
next if ($inferred_op && $value eq "ALL");
@@ -756,39 +802,45 @@
}
if ($value =~ s/^@\[(.*)\]$/$1/ ||# new @[] expressions replace !expr!
- $value =~ s/^@\{(.*)\}$/$1/ ||# depreected. @{x} is interp'd by perl
- $value =~ s/^!expr!//) # deprecated (ugh!)
- {
+ $value =~ s/^@\{(.*)\}$/$1/ ||# deprecated. @{x} is interp'd by perl
+ $value =~ s/^!expr!//) { # deprecated (ugh!)
$quoted = 0;
}
else {
my $c = ($value =~ /,/ &&
- !$tabledef->{param}{$param}{no_auto_in_param}) ? ',' : '';
+ !$table_def->{param}{$param}{no_auto_in_param}) ? ',' : '';
$quoted = (defined $column_def->{quoted}) ?
- ($column_def->{quoted}) : ($value !~ /^-?[0-9.$c]+$/);
+ $column_def->{quoted} : ($value !~ /^-?[0-9.$c]+$/);
}
next if ($inferred_op && !$quoted && $value eq "");
-
- ($sqlop) = grep { defined } (
- {'=' => 'in', '!=' => 'not in' }->{$sqlop}, $sqlop
- ) if $inferred_op;
-
+ if ($inferred_op) {
+ if ($sql_op eq "=") {
+ $sql_op = "in";
+ }
+ elsif ($sql_op eq "!=") {
+ $sql_op = "not in";
+ }
+ }
my $include_null = 0;
- if ($repop eq "contains" || $repop eq "not_contains") {
+ if ($rep_op eq "contains" || $rep_op eq "not_contains") {
+#print STDERR "2. COLUMN: $column : $dbexpr $sql_op $value [CONTAINS]\n";
$value = $dbh->quote("%" . $value . "%");
}
- elsif ($repop eq "matches" || $repop eq "not_matches") {
+ elsif ($rep_op eq "matches" || $rep_op eq "not_matches") {
+#print STDERR "2. COLUMN: $column : $dbexpr $sql_op $value [MATCHES]\n";
$value = $dbh->quote($value);
$value =~ s/_/\\_/g;
$value =~ tr/*?/%_/;
}
- elsif (my ($not) = $sqlop =~ m"(not|) ?in") {
+ elsif (my ($not) = $sql_op =~ m"(not|) ?in") {
+#print STDERR "2. COLUMN: $column : $dbexpr $sql_op $value [IN]\n";
if (! defined $value || $value eq "NULL") {
- $sqlop = $not ? "is $not" : "is";
+#print STDERR "2. COLUMN: $column: value=[$value] sql_op=[$sql_op]\n";
+ $sql_op = $not ? "is $not" : "is";
$value = "null";
}
else {
@@ -796,49 +848,87 @@
$include_null = 1;
}
- $value = $dbh->quote($value) if $quoted;
- if ($value =~ /,/ && ! $tabledef->{param}{$param}{no_auto_in_param}) {
- $value =~ s/,/','/g if $quoted;
+ if ($value =~ /,/ && ! $table_def->{param}{$param}{no_auto_in_param}) {
+ if ($dbexpr_update) {
+ my (@vals);
+ foreach my $val (split(/,/, $value)) {
+ $val = $dbh->quote($val) if ($quoted);
+ push(@vals, sprintf($dbexpr_update, $val));
+ }
+ $value = join(",", @vals);
+ $dbexpr_update_applied = 1;
+#print STDERR "2b COLUMN: $column : $dbexpr $sql_op $value [IN-multi-dbexpr=$dbexpr_update]\n";
+ }
+ else {
+ if ($quoted) {
+ $value = $dbh->quote($value);
+ $value =~ s/,/','/g;
+ }
+#print STDERR "2c COLUMN: $column : $dbexpr $sql_op $value [IN-multi-dbexpr=$dbexpr_update]\n";
+ }
$value = "($value)";
- $sqlop = $not ? "$not in" : "in";
+ $sql_op = $not ? "$not in" : "in";
}
else {
- $sqlop = $not ? "!=" : "=";
+ $value = $dbh->quote($value) if ($quoted);
+ if ($dbexpr_update) {
+ $value = sprintf($dbexpr_update, $value);
+ $dbexpr_update_applied = 1;
+ }
+ $sql_op = $not ? "!=" : "=";
+#print STDERR "2d COLUMN: $column : $dbexpr $sql_op $value [IN-nomulti-dbexpr=$dbexpr_update]\n";
}
}
}
elsif ($quoted) {
+#print STDERR "2. COLUMN: $column : $dbexpr $sql_op $value [QUOTED]\n";
$value = $dbh->quote($value);
+ if ($dbexpr_update) {
+ $value = sprintf($dbexpr_update, $value);
+ $dbexpr_update_applied = 1;
+ }
}
- $dbexpr = $column_def->{dbexpr};
-#[[ from other copy:
-# TODO: use option hash {multitable} to decide on whether to execute this code
-# if (defined $dbexpr && $dbexpr ne "") {
-# $self->_require_tables($dbexpr, \%reqd_tables, $tablealiashref, 2);
-# }
-#]]
- if ($dbexpr) {
+ else {
+#print STDERR "2. COLUMN: $column : $dbexpr $sql_op $value [NOTHING]\n";
+ }
+ #[[ from other copy:
+ # TODO: use option hash {multitable} to decide on whether to execute this code
+ # if (defined $dbexpr && $dbexpr ne "") {
+ # $self->_require_tables($dbexpr, \%reqd_tables, $tablealiashref, 2);
+ # }
+ #]]
+
+ if ($dbexpr && !$dbexpr_update_applied) {
+#print STDERR "3. COLUMN: $column : $dbexpr $sql_op $value\n";
$column = $dbexpr;
$column =~ s/\b$alias\.//g if ($options->{no_aliases});
}
+
if ($include_null) {
- my ($not, $orand) = ($sqlop eq "not in" || $sqlop eq "!=" ) ?
- ("not", "and") : ("", "or");
- push(@where, "($column $sqlop $value $orand $column is $not null)");
+ if ($sql_op eq "not in" || $sql_op eq "!=") {
+ push(@where_conditions, "($column $sql_op $value and $column is not null)");
+ }
+ else {
+ push(@where_conditions, "($column $sql_op $value or $column is null)");
+ }
}
else {
- # push(@where, ($alias ?"$alias.":"")."$column $sqlop $value");
- push(@where, "$column $sqlop $value"); #XXX dow => { alias => 'dow', dbexpr => 'dayofweek(hr.arv_dt)', },
-
+ push(@where_conditions, "$column $sql_op $value");
}
}
- my $where;
- if ($#where > -1) {
- $where = "where " . join("\n and ", @where) . "\n";
+ if (wantarray) {
+ &App::sub_exit(@where_conditions) if ($App::trace);
+ return(@where_conditions);
+ }
+ else {
+ my $where_conditions = "";
+ if ($#where_conditions > -1) {
+ $where_conditions = "where " . join("\n and ", @where_conditions) . "\n";
+ }
+ &App::sub_exit($where_conditions) if ($App::trace);
+ return($where_conditions);
}
- &App::sub_exit($where) if ($App::trace);
- wantarray ? @where : $where;
}
sub _mk_select_sql {
@@ -848,7 +938,7 @@
$params = $self->_key_to_params($table,$params) if (!$params || !ref($params)); # $params is undef/scalar => $key
$cols = [$cols] if (!ref($cols));
- $options = {} if (!$options);
+ $options = $options ? { %$options, no_aliases => 1 } : { no_aliases => 1 };
my ($sql, $order_by, $direction, $col, $colnum, $dir);
$order_by = $options->{order_by} || $options->{ordercols} || []; # {ordercols} is deprecated
@@ -857,7 +947,7 @@
my $modifier = $options->{distinct} ? " distinct" : "";
$sql = "select$modifier\n " . join(",\n ", @$cols) . "\nfrom $table\n";
- $sql .= $self->_mk_where_clause($table, $params, {no_aliases => 1});
+ $sql .= $self->_mk_where_clause($table, $params, $options);
if (defined $order_by && $#$order_by > -1) {
for ($colnum = 0; $colnum <= $#$order_by; $colnum++) {
@@ -893,26 +983,21 @@
my ($self, $table, $params, $cols, $options) = @_;
$self->_load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
- my $dbh = $self->{dbh};
-
my $table_def = $self->get_table_def($table, $options);
- die "Table $table not defined" if (!$table_def);
- if (!defined $params || $params eq "") { $params = {};
- }
- elsif (!ref($params)) {
+ if (!ref($params)) {
$params = $self->_key_to_params($table,$params); # $params is undef/scalar => $key
}
$cols = [$cols] if (!ref($cols));
$options = {} if (!$options);
- my ($order_by, $direction, $param_order, $param, $col, $dir);
- $order_by = $options->{order_by} || $options->{ordercols} || []; # {ordercols} is deprecated
- $order_by = [$order_by] if (!ref($order_by));
- $direction = $options->{direction} || $options->{directions}; # {directions} is deprecated
+ my ($order_by, $direction, $param, $col, $dir);
+ $order_by = $options->{order_by} || $options->{ordercols} || []; # {ordercols} is deprecated
+ $order_by = [$order_by] if (!ref($order_by));
+ $direction = $options->{direction} || $options->{directions}; # {directions} is deprecated
my $modifier = $options->{distinct} ? " distinct" : "";
- my (@criteria_conditions, $repop, $sqlop, $value);
+ my (@where_conditions, $value);
# ADD ANY DEFAULT PARAMS
my $paramdefs = $table_def->{param};
@@ -920,34 +1005,45 @@
if ($paramdefs) {
# make a copy.
# This is necessary if {default} is supplied (see the few lines above)
- # or if the {method} (see way below) is called to modify the $params.
+ # or if the {method} is called to modify the $params.
my %params = %$params;
$params = \%params;
foreach $param (keys %$paramdefs) {
if (! exists $params->{$param} && $paramdefs->{$param}{default}) {
- $params{$param} = $paramdefs->{$param}{default};
+ $params->{$param} = $paramdefs->{$param}{default};
$params_modified = 1;
}
elsif (exists $params->{$param} && $paramdefs->{$param}{method}) {
my $method = $paramdefs->{$param}{method};
- my $param_clause = $self->$method($params, $param, $table);
- if ($param_clause) {
- push(@criteria_conditions, $param_clause);
+ my $where_condition = $self->$method($params, $param, $table);
+ if ($where_condition) {
+ push(@where_conditions, $where_condition);
}
$params_modified = 1;
}
}
}
- # DETERMINE THE ORDER TO PROCESS THE PARAMS
- $param_order = $params->{"_order"};
- if (!defined $param_order) {
- $param_order = [ (keys %$params) ];
- }
- elsif ($params_modified) {
- # TODO: go into a merge between added params and predetermined ordered params
- }
+# # DETERMINE THE ORDER TO PROCESS THE PARAMS
+# $param_order = $params->{"_order"};
+# if (!defined $param_order) {
+# $param_order = [ (keys %$params) ];
+# }
+# elsif ($params_modified) {
+# # merge the added params with the predetermined ordered params
+# my (%param_used);
+# $param_order = [ @$param_order ];
+# foreach my $param (@$param_order) {
+# $param_used{$param} = 1;
+# }
+# foreach my $param (keys %$params) {
+# if (!$param_used{$param}) {
+# push(@$param_order, $param);
+# $param_used{$param} = 1;
+# }
+# }
+# }
my $startrow = $options->{startrow} || 0;
my $endrow = $options->{endrow} || 0;
@@ -955,7 +1051,7 @@
my $keycolidx = $options->{keycolidx};
my $writeref = $options->{writeref};
my $reptyperef = $options->{reptyperef};
- my $group_by = $options->{group_by} || $options->{summarykeys};
+ my $group_by = $options->{group_by} || $options->{summarykeys}; # {summarykeys} is deprecated
my ($tablealiases, $tablealiashref);
@@ -979,6 +1075,7 @@
my $alias = $column;
$alias =~ s/[^_a-zA-Z0-9.]+/_/g;
$alias =~ s/^([0-9])/_$1/;
+ $alias = "x$alias" if ($alias =~ /^_/); # some db's (i.e. Oracle) don't allow aliases that start with "_"
$column_def = {
dbexpr => $column,
alias => $alias,
@@ -999,7 +1096,7 @@
$primary_table = "";
if ($is_summary) {
- foreach $column (@$group_by) { # primary key is list of summary keys
+ foreach $column (@$group_by) { # primary key is list of summary keys
$is_summary_key{$column} = 1;
$colidx = $columnidx{$column};
if (! defined $colidx && $auto_extend) {
@@ -1052,7 +1149,7 @@
$column = $cols->[$idx];
$column_def = $table_def->{column}{$column};
if (!defined $column_def) {
- push(@select_phrase, "NULL u$idx");
+ push(@select_phrase, "NULL");
next;
}
@@ -1078,7 +1175,7 @@
if ($is_summary) {
if ($is_summary_key{$column}) {
if (defined $dbexpr) {
- push(@select_phrase, "$dbexpr as $columnalias");
+ push(@select_phrase, $columnalias ? "$dbexpr as $columnalias" : $dbexpr);
push(@group_summarykeys, $dbexpr);
}
}
@@ -1098,17 +1195,18 @@
}
}
}
+
if (defined $dbexpr) {
$summaryexpr =~ s#\$#$dbexpr#g; # substitute the dbexpr into the summaryexpr
}
else {
$summaryexpr = "NULL";
}
- push(@select_phrase, "$summaryexpr as $columnalias") if ($summaryexpr);
+ push(@select_phrase, $columnalias ? "$dbexpr as $columnalias" : $dbexpr);
}
}
else {
- push(@select_phrase, (defined $dbexpr) ? "$dbexpr as $columnalias" : "NULL $columnalias");
+ push(@select_phrase, ((defined $dbexpr) ? $dbexpr : "NULL") . ($columnalias ? " as $columnalias" : ""));
}
############################################################
@@ -1214,7 +1312,7 @@
#print $App::DEBUG_FILE $self->{context}->dump(), "\n";
- @criteria_conditions = $self->_mk_where_clause($table, $params, $options);
+ @where_conditions = $self->_mk_where_clause($table, $params, $options);
############################################################
# put tables in table list in the standard order
@@ -1222,60 +1320,33 @@
############################################################
my ($dbtable, $tablealias, @from_tables, $tableref);
- my (@outer_join_clauses, @join_conditions);
+ my (@join_clauses, @join_conditions, $joincriteria);
- #print STDERR join ", ", "HERE" , map { Dumper($tablealiashref->{$_}->{dependencies})} @$tablealiases;
- #print STDERR join ", ", "HERE0", map {@{($tablealiashref->{$_}->{dependencies} || [])}, $_} @$tablealiases,"\n";
- #print STDERR join ", ", "HERE1", map {(grep {!/^$_$/} @{($tablealiashref->{$_}->{dependencies} || [])}), $_} @$tablealiases,"\n";
- my %deps = map {
- $table = $_;
- $_ => [
- grep {!/^$table$/}
- @{($tablealiashref->{$table}->{dependencies} || [])}
- ]
- } @$tablealiases;
-
- use Algorithm::Dependency::Ordered;
- use Algorithm::Dependency::Source::HoA;
-
- my $src = Algorithm::Dependency::Source::HoA->new({%deps});
- my $queue = Algorithm::Dependency::Ordered->new(source=>$src);
- #print STDERR 'Deps:'. Dumper({%deps});
- #print STDERR 'queue:'. Dumper($queue->schedule_all);
- #foreach $tablealias (map {(grep {!/^$_$/} @{($tablealiashref->{$_}->{dependencies} || [])}), $_} @$tablealiases) {
-
- ##TODO Fix: There is some major uglyness in here with the $cnt stuff.
- ## Bigger fish to fry right now. Come back later. #rl
- my $cnt = 0;
- foreach $tablealias (@{$queue->schedule_all}) {
+ foreach $tablealias (@$tablealiases) {
#print $App::DEBUG_FILE "checking table $tablealias\n";
- $dbtable = $tablealiashref->{$tablealias}{table};
- $tableref = ($dbtable) ? "$dbtable $tablealias" : $tablealias;
- my $where_condition = $tablealiashref->{$tablealias}{joincriteria};
- if ($where_condition =~ /\{.*\}/) {
- print STDERR "WHERE1: $where_condition\n";
- $where_condition = $self->substitute($where_condition);
- print STDERR "WHERE2: $where_condition\n";
- }
-
- # First time thouh loop We can't do a join on, so if we find anything
- # tack it onto the where condition.
- if (0 == $cnt++ && $where_condition) {
- push @criteria_conditions, $where_condition;
- undef $where_condition;
- }
- my $join_type =
- $tablealiashref->{$tablealias}{cardinality_zero} ? 'left' : '';
- push( @outer_join_clauses,
- "$join_type join $tableref on $where_condition")if($where_condition);
-
- #rl address !$join_type... See if needed.
- if (!$join_type && $tablealiashref->{$tablealias}{hint}) {
- $tableref .= " $tablealiashref->{$tablealias}{hint}";
+ if ($reqd_tables{$tablealias}) {
+ $dbtable = $tablealiashref->{$tablealias}{table};
+ $tableref = ($dbtable) ? "$dbtable $tablealias" : $tablealias;
+ $joincriteria = $tablealiashref->{$tablealias}{joincriteria};
+ if ($joincriteria =~ /\{.*\}/) {
+ $joincriteria = $self->substitute($joincriteria, $params);
+ }
+ if ($tablealiashref->{$tablealias}{cardinality_zero}) {
+ push(@join_clauses, " left join $tableref on $joincriteria") if ($joincriteria);
+ #print $App::DEBUG_FILE " $tablealias is [$dbtable] as [$tableref] where [$joincriteria] (outer)\n";
+ }
+ elsif ($joincriteria) {
+ push(@join_clauses, " inner join $tableref on $joincriteria");
+ }
+ else {
+ #push(@join_clauses, split(/ +and +/,$joincriteria)) if ($joincriteria);
+ if ($tablealiashref->{$tablealias}{hint}) {
+ $tableref .= " $tablealiashref->{$tablealias}{hint}";
+ }
+ push(@from_tables, $tableref);
+ #print $App::DEBUG_FILE " $tablealias is [$dbtable] as [$tableref] where [$joincriteria]\n";
+ }
}
- push(@from_tables, $tableref) if !$join_type && $cnt <=1;
- push( @outer_join_clauses,
- "join $tableref") if (!$where_condition && $cnt>1);
}
if ($#from_tables == -1 && $#$tablealiases > -1) {
$tablealias = $tablealiases->[0];
@@ -1285,6 +1356,7 @@
$tableref .= " $tablealiashref->{$tablealias}{hint}";
}
push(@from_tables, $tableref);
+ shift(@join_clauses);
}
############################################################
@@ -1292,28 +1364,26 @@
############################################################
my $sql = "select$modifier\n " .
- join(",\n ",@select_phrase) . "\n" .
- "from\n " .
- join(",\n ",@from_tables) . "\n";
+ join(",\n ",@select_phrase) . "\n" .
+ "from " .
+ join(",\n ",@from_tables) . "\n";
- if ($#outer_join_clauses >= 0) {
- $sql .= join("\n",@outer_join_clauses) . "\n";
+ if ($#join_clauses >= 0) {
+ $sql .= join("\n", @join_clauses) . "\n";
}
- if ($#criteria_conditions >= 0) {
+ if ($#where_conditions >= 0) {
my $conjunction = uc($params->{"_conjunction"}) if (defined $params);
- my ($not, $andor) = @{{
- NOT_AND => [qw(not and)], NOT_OR=> [qw(not and)], OR => ['', 'or'],
- AND => ['', 'and']
- }->{$conjunction} || ['', 'and']};
+ my $not = ($conjunction =~ /NOT/) ? "not" : "";
+ my $andor = ($conjunction =~ /OR/) ? "or" : "and";
- $sql .= 'where '; #($#join_conditions == -1 ? "where " : " and ");
+ $sql .= 'where ';
if ($not) {
- $sql .= "$not (" . join("\n $andor ",@criteria_conditions) . ")\n";
+ $sql .= "$not (" . join("\n $andor ",@where_conditions) . ")\n";
}
else {
- $sql .= join("\n $andor ",@criteria_conditions) . "\n";
+ $sql .= join("\n $andor ",@where_conditions) . "\n";
}
}
if ($#group_summarykeys >= 0) {
@@ -1333,6 +1403,7 @@
# return the SQL statement
############################################################
&App::sub_exit($sql) if ($App::trace);
+ #print STDERR "DBI/_mk_select_joined_sql sql=[$sql]\n";
return($sql);
}
@@ -1344,6 +1415,7 @@
}
sub _require_tables {
+ &App::sub_entry;
&App::sub_entry if ($App::trace >= 3);
my ($self, $dbexpr, $reqd_tables, $relationship_defs, $require_type) = @_;
#print $App::DEBUG_FILE "_require_tables($dbexpr,...,...,$require_type)\n";
@@ -1354,23 +1426,24 @@
push(@relationship, $1);
$tableseen{$1} = 1;
}
- while ($relationship = pop(@relationship)) {
- if (0 && ! defined $reqd_tables->{$relationship}) {
- $reqd_tables->{$relationship} = $require_type;
- #print $App::DEBUG_FILE "table required: $relationship => $require_type\n";
- #print STDERR "\ttable required: $relationship => $require_type\n";
- $dependencies = $relationship_defs->{$relationship}{dependencies};
- push(@relationship, @$dependencies)
- if (defined $dependencies && ref($dependencies) eq "ARRAY");
- }
- elsif ($reqd_tables->{$relationship} < $require_type) {
- $reqd_tables->{$relationship} = $require_type;
- #print $App::DEBUG_FILE "table required: $relationship => $require_type\n";
- #print STDERR "\ttable required: $relationship => $require_type\n";
- }
- }
+ }
+ while ($relationship = pop(@relationship)) {
+ if (! defined $reqd_tables->{$relationship}) {
+ $reqd_tables->{$relationship} = $require_type;
+ #print $App::DEBUG_FILE "table required: $relationship => $require_type\n";
+ #print STDERR "\ttable required: $relationship => $require_type\n";
+ $dependencies = $relationship_defs->{$relationship}{dependencies};
+ push(@relationship, @$dependencies)
+ if (defined $dependencies && ref($dependencies) eq "ARRAY");
+ }
+ elsif ($reqd_tables->{$relationship} < $require_type) {
+ $reqd_tables->{$relationship} = $require_type;
+ #print $App::DEBUG_FILE "table required: $relationship => $require_type\n";
+ #print STDERR "\ttable required: $relationship => $require_type\n";
+ }
}
&App::sub_exit() if ($App::trace >= 3);
+ &App::sub_exit();
}
# $insert_sql = $rep->_mk_insert_row_sql ($table, \@cols, \@row);
@@ -1378,24 +1451,48 @@
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row) = @_;
- $self->_load_table_metadata($table)
- if (!defined $self->{table}{$table}{loaded});
+ $self->_load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my $dbh = $self->{dbh};
+ my ($sql, $values, $col, $value, $colnum, $quoted);
+ #print $App::DEBUG_FILE "_mk_insert_row_sql($table,\n [",
+ # join(",",@$cols), "],\n [",
+ # join(",",@$row), "])\n";
+
if ($#$cols == -1) {
$self->{error} = "Database->_mk_insert_row_sql(): no columns specified";
return();
}
- my $tabcols = $self->{table}{$table}{column};
-
- my $qtable = $table ; #$dbh->quote_identifier($table);
- my $sql = qq{insert into $qtable (} . (join ',', @$cols). ") values (";
- $sql .= (join ",", map {
- my $x;
- $tabcols->{$_}{dbexpr_update} ? sprintf($x, "?"): "?";
- } @$cols). ")";
-
+ my $column_defs = $self->{table}{$table}{column};
+ $sql = "insert into $table\n";
+ $values = "values\n";
+ for ($colnum = 0; $colnum <= $#$cols; $colnum++) {
+ $col = $cols->[$colnum];
+ if (!defined $row || $#$row == -1) {
+ $value = "?";
+ }
+ else {
+ $value = $row->[$colnum];
+ if (!defined $value) {
+ $value = "NULL";
+ }
+ else {
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ if ($quoted) {
+ $value = $dbh->quote($value);
+ }
+ }
+ }
+ $sql .= ($colnum == 0) ? " ($col" : ",\n $col";
+ if ($column_defs->{$col}{dbexpr_update}) {
+ $value = sprintf($column_defs->{$col}{dbexpr_update}, $value);
+ }
+ $values .= ($colnum == 0) ? " ($value" : ",\n $value";
+ }
+ $sql .= ")\n";
+ $values .= ")\n";
+ $sql .= $values;
&App::sub_exit($sql) if ($App::trace);
$sql;
}
@@ -1421,7 +1518,7 @@
}
my ($col, $value, $colidx, $quoted);
- my $tabcols = $self->{table}{$table}{column};
+ my $column_defs = $self->{table}{$table}{column};
my $by_expression = ($options && $options->{by_expression}) ? 1 : 0;
my @values = ();
@@ -1439,12 +1536,12 @@
push(@values, $value);
}
else {
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted) {
$value = $dbh->quote($value);
}
- if ($tabcols->{$col}{dbexpr_update}) {
- $value = sprintf($tabcols->{$col}{dbexpr_update}, $value);
+ if ($column_defs->{$col}{dbexpr_update}) {
+ $value = sprintf($column_defs->{$col}{dbexpr_update}, $value);
}
push(@values, $value);
}
@@ -1468,10 +1565,11 @@
$self->_load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my $dbh = $self->{dbh};
- my $tabcols = $self->{table}{$table}{column};
+ my $column_defs = $self->{table}{$table}{column};
my $by_expression = $options->{by_expression};
my (@noupdate, %noupdate, @set, $where);
+ my (@set_bind_var_idx, @where_bind_var_idx);
$noupdate[$#$cols] = 0; # pre-extend the array
%noupdate = ();
@@ -1491,7 +1589,7 @@
die "_mk_update_sql() can't update with key because {table}{$table}{primary_key} not defined"
if (!defined $col);
if (!ref($col)) {
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted && !$by_expression) {
$value = $dbh->quote($value);
}
@@ -1505,7 +1603,7 @@
for ($colidx = 0; $colidx <= $#$params; $colidx++) {
$col = $params->[$colidx];
$value = $values[$colidx];
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted && !$by_expression) {
$value = $dbh->quote($value);
}
@@ -1535,13 +1633,14 @@
$value = "NULL";
}
else {
- $quoted = (defined $tabcols->{$col}{quoted})?($tabcols->{$col}{quoted}):($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted})?($column_defs->{$col}{quoted}):($value !~ /^-?[0-9.]+$/);
if ($quoted) {
$value = $dbh->quote($value);
}
}
}
push(@where, "$col = $value");
+ push(@where_bind_var_idx, $i);
$noupdate[$colidx] = 1;
}
}
@@ -1561,6 +1660,7 @@
$col = $cols->[$colidx];
next if ($noupdate{$col});
push(@set, "$col = ?");
+ push(@set_bind_var_idx, $colidx);
}
}
else {
@@ -1571,20 +1671,24 @@
next if ($noupdate{$col});
$value = $is_array ? $row->[$colidx] : $row->{$col};
if (!defined $value) {
- push(@set, "$col = NULL");
+ push(@set, "$col is null");
}
else {
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted && !$by_expression) {
$value = $dbh->quote($value);
}
- if ($tabcols->{$col}{dbexpr_update}) {
- $value = sprintf($tabcols->{$col}{dbexpr_update}, $value, $value, $value, $value, $value);
+ if ($column_defs->{$col}{dbexpr_update}) {
+ $value = sprintf($column_defs->{$col}{dbexpr_update}, $value, $value, $value, $value, $value);
}
push(@set, "$col = $value");
+ push(@set_bind_var_idx, $colidx);
}
}
}
+ if ($options->{bind_var_idx} && $#set_bind_var_idx > -1 && $#where_bind_var_idx > -1) {
+ @{$options->{bind_var_idx}} = (@set_bind_var_idx, @where_bind_var_idx);
+ }
my $sql = "update $table set\n " . join(",\n ",@set) . "\n" . $where;
&App::sub_exit($sql) if ($App::trace);
@@ -1605,7 +1709,7 @@
$self->_load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my $dbh = $self->{dbh};
- my $tabcols = $self->{table}{$table}{column};
+ my $column_defs = $self->{table}{$table}{column};
my $by_expression = $options->{by_expression};
my $where = "";
@@ -1629,7 +1733,7 @@
die "_mk_delete_sql() can't delete with key because {table}{$table}{primary_key} not defined"
if (!defined $col);
if (!ref($col)) {
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted && !$by_expression) {
$value = $dbh->quote($value);
}
@@ -1642,7 +1746,7 @@
for ($colidx = 0; $colidx <= $#$params; $colidx++) {
$col = $params->[$colidx];
$value = $values[$colidx];
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted && !$by_expression) {
$value = $dbh->quote($value);
}
@@ -1672,7 +1776,7 @@
}
else {
#TODO: FiX quoting to use lookslikeanumber();
- $quoted = (defined $tabcols->{$col}{quoted})?($tabcols->{$col}{quoted}):($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted})?($column_defs->{$col}{quoted}):($value !~ /^-?[0-9.]+$/);
if ($quoted) {
$value = $dbh->quote($value);
}
@@ -1707,7 +1811,7 @@
$self->{error} = "Database->_mk_delete_row_sql(): no columns specified";
return();
}
- my $tabcols = $self->{table}{$table}{column};
+ my $column_defs = $self->{table}{$table}{column};
$colused[$#$cols] = 0; # pre-extend the array
@@ -1726,7 +1830,7 @@
$value = "NULL";
}
else {
- $quoted = (defined $tabcols->{$col}{quoted}) ? ($tabcols->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
+ $quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted) {
$value = $dbh->quote($value);
}
@@ -1743,15 +1847,16 @@
$sql;
}
-# $delete_sql = $rep->_mk_delete_rows_sql($table, \@params, \%paramvalues);
+# $delete_sql = $rep->_mk_delete_rows_sql($table, \@params, \%options);
sub _mk_delete_rows_sql {
&App::sub_entry if ($App::trace);
- my ($self, $table, $params, $paramvalues) = @_;
+ my ($self, $table, $params, $options) = @_;
+ $options = $options ? { %$options, no_aliases => 1 } : { no_aliases => 1 };
$self->_load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql);
$sql = "delete from $table\n";
- $sql .= $self->_mk_where_clause($table, $params, {no_aliases => 1});
+ $sql .= $self->_mk_where_clause($table, $params, $options);
&App::sub_exit($sql) if ($App::trace);
$sql;
}
@@ -1846,67 +1951,79 @@
sub _insert_row {
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row, $options) = @_;
- # warn "Cols". Dumper($cols);
$self->{error} = "";
-
+ my $sql = $self->_mk_insert_row_sql($table, $cols, undef, $options);
+ $self->{sql} = $sql;
my $dbh = $self->{dbh};
- my $sql;
- my $sth = delete $self->{sth}; #rl XXX Hack fix this.
- if (!$sth) {
- $sql = $self->_mk_insert_row_sql($table, $cols, undef, $options);
- confess "No SQL at _insert_row" if !$sql;
- $self->{sql} = $sql;
- $sth = $dbh->prepare($sql);
- } else {
- $sql = $self->{sql};
- }
my $retval = 0;
- my $context_options = $self->{context}{options};
+ my $context = $self->{context};
+ my $context_options = $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) {
+ my ($column, %serializer, $serializer_name, $serializer, $sqltype);
+ my $column_defs = $self->{table}{$table}{column};
eval {
- my $proceed_with_insert = 1;
- if ($options->{replace} || $options->{update}) {
- my $pk_idx = $self->_check_row($table, $cols, $row);
- if ($pk_idx) {
- if ($options->{replace}) {
- $self->_delete_row($table, $cols, $row, [$pk_idx]);
- } else {
- $retval = $self->_update($table, [$pk_idx],$cols, $row);
- $self->_set_insert_id($table, $cols, $row);
- $proceed_with_insert = 0;
+ my $insert_sth = $dbh->prepare($sql);
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $column = $cols->[$i];
+ $sqltype = $column_defs->{$column}{sqltype};
+ $serializer_name = $column_defs->{$column}{serializer};
+ if ($serializer_name) {
+ $serializer = $serializer{$serializer_name};
+ if (!$serializer) {
+ $serializer = $context->serializer($serializer_name);
+ $serializer{$serializer_name} = $serializer;
+ }
+ if ($row->[$i] ne "") {
+ $row->[$i] = $serializer->serialize($row->[$i]);
}
}
+ $insert_sth->bind_param($i+1, undef, $sqltype ? {TYPE => $sqltype} : () );
}
- if ($proceed_with_insert) {
- for(my $i = 0; $i<@$cols; ++$i) {
- my $type=$self->{table}{$table}{column}{$cols->[$i]}{stype};
- $sth->bind_param(
- $i+1, $row->[$i],$type ? {TYPE=>$type} : ()
- );
- }
- $retval = $sth->execute(@$row);
- $self->_set_insert_id($table, $cols, $row);
- $retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
+ 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;
}
+ $retval = $insert_sth->execute(@$row);
+ $retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
};
if (my $e = $@) { # Log the error message with the SQL and rethrow the exception
- my $bind_values = join("|", map { defined $_ ? $_ : "undef" } @$row);
- $loglevel = 3 if ($self->is_duplicate_key_error($e));
- $self->{context}->log({level=>$loglevel}, "DBI Exception (fail) in _insert_row(): ${e}BIND VALUES: [$bind_values]\nSQL: $sql");
- confess $e;
+#print STDERR "###### EXCEPTION: $e\n";
+ if ($self->is_duplicate_key_error($e)) {
+ if ($options->{update} || $options->{replace}) {
+ my ($key_idx);
+ my $update_keys = $options->{update} || $options->{replace};
+ if (ref($update_keys) eq "HASH") {
+ my @key_columns = (keys %$update_keys);
+ $key_idx = $self->_key_idx($table, $cols);
+#print STDERR "###### EXCEPTION: UPDATING cols=[@$cols] keys=[@key_columns] so idx=[@$key_idx]\n";
+ }
+ else {
+ $key_idx = $self->_key_idx($table, $cols);
+ }
+ $retval = $self->_update($table, $key_idx, $cols, $row);
+ if (!$retval) {
+ $loglevel = 3;
+ my $bind_values = join("|", map { defined $_ ? $_ : "undef" } @$row);
+ $self->{context}->log({level=>$loglevel}, "App-Repository Exception in _insert_row(): update failed to find row after failed insert\nBIND VALUES: [$bind_values]\nSQL: $sql");
+ die $e;
+ }
+ }
+ else {
+ $loglevel = 3;
+ my $bind_values = join("|", map { defined $_ ? $_ : "undef" } @$row);
+ $self->{context}->log({level=>$loglevel}, "DBI Exception (fail) in _insert_row(): ${e}BIND VALUES: [$bind_values]\nSQL: $sql");
+ die $e;
+ }
+ }
}
}
if ($debug_sql) {
@@ -1922,26 +2039,128 @@
# $nrows = $rep->_insert_rows ($table, \@cols, \@rows);
sub _insert_rows {
&App::sub_entry if ($App::trace);
- my ($self, $table, $cols, $rows, $options) = @_; $self->{error} = "";
+ my ($self, $table, $cols, $rows, $options) = @_;
+ $self->{error} = "";
my ($sql, $retval);
- my $debug_sql = $self->{context}{options}->{debug_sql};
my $dbh = $self->{dbh};
return 0 if (!defined $dbh);
my $nrows = 0;
+ my $ok = 1;
+ my $context = $self->{context};
+ my $context_options = $context->{options};
+ my $debug_sql = $context_options->{debug_sql};
+ my $explain_sql = $context_options->{explain_sql};
my ($timer, $elapsed_time);
-
- if (ref($rows) ne "ARRAY") {
- return $self->import_rows(@_[1..$#_]);
+ my $loglevel = 1;
+ if ($debug_sql) {
+ $timer = $self->_get_timer();
}
-
- $timer = $self->_get_timer() if ($debug_sql); #return timer object.
- $sql = $self->_mk_insert_row_sql($table, $cols);
- $self->{sth} = $dbh->prepare($sql); #XXX hack for now -- backend pass of sth
- foreach my $row (@$rows) {
- $self->_insert_row($table, $cols, $row, $options);
- ++$nrows;
+ if (ref($rows) eq "ARRAY") {
+ $sql = $self->_mk_insert_row_sql($table, $cols);
+ foreach my $row (@$rows) {
+ if ($explain_sql) {
+ $self->explain_sql($sql);
+ }
+ if (defined $dbh) {
+ my ($column, %serializer, $serializer_name, $serializer, $sqltype);
+ my $column_defs = $self->{table}{$table}{column};
+ eval {
+ ### TODO: make this work with regex for retry
+ my $insert_sth = $dbh->prepare($sql);
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $column = $cols->[$i];
+ $sqltype = $column_defs->{$column}{sqltype};
+ $serializer_name = $column_defs->{$column}{serializer};
+ if ($serializer_name) {
+ $serializer = $serializer{$serializer_name};
+ if (!$serializer) {
+ $serializer = $context->serializer($serializer_name);
+ $serializer{$serializer_name} = $serializer;
+ }
+ if ($row->[$i] ne "") {
+ $row->[$i] = $serializer->serialize($row->[$i]);
+ }
+ }
+ $insert_sth->bind_param($i+1, undef, $sqltype ? {TYPE => $sqltype} : () );
+ }
+ 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;
+ }
+ #$retval = $dbh->do($sql, undef, @$row);
+ $retval = $insert_sth->execute(@$row);
+ $retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
+ };
+ if (my $e = $@) { # Log the error message with the SQL and rethrow the exception
+ $loglevel = $self->is_duplicate_key_error($e) ? 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 $e;
+ }
+ }
+ if ($debug_sql) {
+ print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
+ print $App::DEBUG_FILE "\n";
+ }
+
+ if ($retval) {
+ $nrows ++;
+ }
+ else {
+ $self->{numrows} = $nrows;
+ $ok = 0;
+ last;
+ }
+ }
+ }
+ else {
+ my $fh = $rows; # assume it is a file handle
+ $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 (my $e = $@) { # Log the error message with the SQL and rethrow the exception
+ $loglevel = $self->is_duplicate_key_error($e) ? 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 $e;
+ }
+ }
+ if ($debug_sql) {
+ print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
+ print $App::DEBUG_FILE "\n";
+ }
+
+ if ($retval) {
+ $nrows ++;
+ }
+ else {
+ $self->{numrows} = $nrows;
+ $ok = 0;
+ }
+ }
+ }
}
if ($debug_sql) {
$elapsed_time = $self->_read_timer($timer);
@@ -1953,50 +2172,6 @@
return($nrows);
}
-sub _check_row {
- my $self = shift;
- my ($table, $cols, $row) = @_;
- my $dbh = $self->{dbh};
-
- #my $pk = $dbh->quote_identifier($self->{table}{$table}{primary_key}[0]);
- my $pk = $self->{table}{$table}{primary_key}[0];
- my $qtable = $table; #$dbh->quote_identifier($table);
- my ($check_pk, $check_ak);
-
-
- my $pk_col;
- my $pknum=0;
- for my $col (@$cols) {
- if ($col eq $self->{table}{$table}->{primary_key}[0]) {
- $pk_col = $pknum;
- }
- ++$pknum;
- }
-
- $check_pk = $dbh->prepare(qq{
- SELECT count(*) FROM $qtable WHERE $pk = ?
- });
-
- $check_ak = $dbh->prepare(
- qq{SELECT count(*) FROM $qtable WHERE }. join " OR ", map {
- my $key = $_;
- my $col = $dbh->quote_identifier($key);
- $key ? qq{($col IN (?) AND $col IS NOT NULL)} : ();
- } @{$self->{table}{$table}{alternate_key}}
- ) if $self->{table}{$table}{alternate_key};
- my $exists;
- if (defined($pk_col)) {
- $check_pk->execute($row->[$pk_col]);
- ($exists) = $check_pk->fetchrow_array; $check_pk->finish();
- }
- # $check_ak->execute(@$cols);
- # ($exists) ||= $check_ak->fetchrow_array; $check_ak->finish();
-
- return $pk_col if $exists; #XXX another ugly HACK.
-}
-
-
-
sub _delete {
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
@@ -2047,26 +2222,59 @@
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->{error} = "";
- my $sql = $self->_mk_update_sql($table, $params, $cols, $row, $options);
+ $options = $options ? { %$options } : {};
+ my (@bind_var_idx);
+ $options->{bind_var_idx} = \@bind_var_idx;
+ my $sql = $self->_mk_update_sql($table, $params, $cols, undef, $options); # SEB removed $row, added undef
$self->{sql} = $sql;
- my $context_options = $self->{context}{options};
+ my $context = $self->{context};
+ my $context_options = $context->{options};
my $debug_sql = $context_options->{debug_sql};
my ($timer, $elapsed_time);
- if ($debug_sql) {
- $timer = $self->_get_timer();
- print $App::DEBUG_FILE "DEBUG_SQL: _update()\n";
- print $App::DEBUG_FILE $sql;
- }
if ($context_options->{explain_sql}) {
$self->explain_sql($sql);
}
my $retval = 0;
my $dbh = $self->{dbh};
if (defined $dbh) {
+ my ($column, %serializer, $serializer_name, $serializer, $sqltype, $colidx);
+ my $column_defs = $self->{table}{$table}{column};
eval {
+ if ($#bind_var_idx == -1) {
+ @bind_var_idx = (0 .. $#$row);
+ }
### TODO: make this work with regex for retry
- $retval = $dbh->do($sql);
+ my $update_sth = $dbh->prepare($sql);
+ for (my $i = 0; $i <= $#bind_var_idx; $i++) {
+ $colidx = $bind_var_idx[$i];
+ $column = $cols->[$colidx];
+ $sqltype = $column_defs->{$column}{sqltype};
+ $serializer_name = $column_defs->{$column}{serializer};
+ if ($serializer_name) {
+ $serializer = $serializer{$serializer_name};
+ if (!$serializer) {
+ $serializer = $context->serializer($serializer_name);
+ $serializer{$serializer_name} = $serializer;
+ }
+ $row->[$colidx] = $serializer->serialize($row->[$colidx]);
+ }
+ $update_sth->bind_param($i+1, undef, $sqltype ? {TYPE => $sqltype} : () );
+ }
+
+ if ($#bind_var_idx > -1) {
+ $row = [ @{$row}[@bind_var_idx] ];
+ }
+ if ($debug_sql) {
+ $timer = $self->_get_timer();
+ print $App::DEBUG_FILE "DEBUG_SQL: _update()\n";
+ print $App::DEBUG_FILE "DEBUG_SQL: bind vars [", join("|",map { defined $_ ? $_ : "undef" } @$row), "]\n";
+ print $App::DEBUG_FILE $sql;
+ }
+ $retval = $update_sth->execute(@$row);
+
+ #$retval = $update_sth->execute();
+ #$retval = $dbh->do($sql);
$retval = 0 if ($retval == 0); # turn "0E0" into plain old "0"
};
if (my $e = $@) { # Log the error message with the SQL and rethrow the exception
@@ -2126,7 +2334,7 @@
$retval;
}
-# $ok = $rep->_delete_rows($table, \@params, \%paramvalues);
+# $ok = $rep->_delete_rows($table, \@params, \%options);
sub _delete_rows {
&App::sub_entry if ($App::trace);
my $self = shift;
@@ -2189,7 +2397,6 @@
if ($context_options->{explain_sql}) {
$self->explain_sql($sql);
}
- ### TODO: make this work with regex for retry
if (defined $dbh) {
$self->{sql} = $sql;
my $continue = 1;
@@ -2445,10 +2652,6 @@
# METADATA REPOSITORY METHODS (implements methods from App::Repository)
######################################################################
-# REMOVE ALL DEPENDENCE ON DBIx::Compat
-# (ok. I want to, but I'm not ready to rewrite ListFields.)
-use DBIx::Compat;
-
sub _load_rep_metadata_from_source {
&App::sub_entry if ($App::trace);
my ($self) = @_;
@@ -2470,16 +2673,7 @@
# in MySQL 4.0.13, the table names are surrounded by backticks (!?!)
# so for safe measure, get rid of all quotes
# Also, get rid of prepended schema names.
-#TODO: Repository Specific way of getting table names;
- @tables = map {lc} grep(s/^[^.]+\.//, grep(s/['"`]//g, $dbh->tables(undef, undef, undef, "TABLE")));
-
- # REMOVE ALL DEPENDENCE ON DBIx::Compat
- # if the DBI method doesn't work, try the DBIx method...
- # if ($#tables == -1) {
- # $func = DBIx::Compat::GetItem($dbdriver, "ListTables");
- # @tables = &{$func}($dbh);
- # }
-my ($sql);
+ @tables = $self->_get_tables_from_source();
# go through the list of native tables from the database
foreach $table (@tables) {
@@ -2508,6 +2702,76 @@
($ntype_attribute_idx,@ntype_attribute_values) = @{$dbh->type_info_all||[]};
# go through the list of native type info from the DBI handle
+ # MySQL
+ # TYPE: varchar num|12|column_size|255||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: decimal num|3|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: tinyint num|-6|column_size|3||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: smallint num|5|column_size|5||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: integer num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: float num|7|column_size|7||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: double num|6|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: double num|8|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: timestamp num|11|column_size|14||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: bigint num|-5|column_size|19||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: mediumint num|4|column_size|8||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: date num|9|column_size|10||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: time num|10|column_size|6||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: datetime num|11|column_size|21||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: year num|5|column_size|4||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: date num|9|column_size|10||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: enum num|12|column_size|255||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: set num|12|column_size|255||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: blob num|-4|column_size|65535||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: tinyblob num|-3|column_size|255||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: mediumblob num|-4|column_size|16777215||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: longblob num|-4|column_size|2147483647||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: char num|1|column_size|255||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: decimal num|2|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: tinyint unsigned num|-6|column_size|3||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: smallint unsigned num|5|column_size|5||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: mediumint unsigned num|4|column_size|8||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: int unsigned num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: int num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: integer unsigned num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: bigint unsigned num|-5|column_size|20||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: text num|-1|column_size|65535||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: mediumtext num|-1|column_size|16777215||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: mediumint unsigned auto_increment num|4|column_size|8||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|1
+ # TYPE: tinyint unsigned auto_increment num|-6|column_size|3||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|1
+ # TYPE: smallint auto_increment num|5|column_size|5||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: int unsigned auto_increment num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|1
+ # TYPE: mediumint num|4|column_size|7||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: bit num|-7|column_size|1||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: numeric num|2|column_size|19||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: integer unsigned auto_increment num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|1
+ # TYPE: mediumint unsigned num|4|column_size|8||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|0
+ # TYPE: smallint unsigned auto_increment num|5|column_size|5||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|1
+ # TYPE: int auto_increment num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: long varbinary num|-4|column_size|16777215||literal_prefix|0x||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: double auto_increment num|6|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: double auto_increment num|8|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: integer auto_increment num|4|column_size|10||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: bigint auto_increment num|-5|column_size|19||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: bit auto_increment num|-7|column_size|1||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: mediumint auto_increment num|4|column_size|7||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: float auto_increment num|7|column_size|7||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: long varchar num|-1|column_size|16777215||literal_prefix|'||literal_suffix|'|unsigned_attribute|0||auto_unique_value|0
+ # TYPE: tinyint auto_increment num|-6|column_size|3||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|1
+ # TYPE: bigint unsigned auto_increment num|-5|column_size|20||literal_prefix|||literal_suffix||unsigned_attribute|1||auto_unique_value|1
+
+ # ORACLE
+ # TYPE: LONG RAW num|-4|column_size|2147483647||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|
+ # TYPE: RAW num|-3|column_size|2000||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|
+ # TYPE: LONG num|-1|column_size|2147483647||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|
+ # TYPE: CHAR num|1|column_size|2000||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|0
+ # TYPE: DECIMAL num|3|column_size|38||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: DOUBLE PRECISION num|8|column_size|15||literal_prefix|||literal_suffix||unsigned_attribute|0||auto_unique_value|0
+ # TYPE: DATE num|93|column_size|19||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|0
+ # TYPE: VARCHAR2 num|12|column_size|4000||literal_prefix|'|name|VARCHAR2|literal_suffix|'|unsigned_attribute|||auto_unique_value|0
+ # TYPE: BLOB num|-4|column_size|2147483647||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|
+ # TYPE: BFILE num|-4|column_size|2147483647||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|
+ # TYPE: CLOB num|-1|column_size|2147483647||literal_prefix|'||literal_suffix|'|unsigned_attribute|||auto_unique_value|
+
my (@ntype_names);
foreach my $ntype_attribute_values (@ntype_attribute_values) {
@@ -2520,7 +2784,7 @@
$ntype_def->{$key} = $ntype_attribute_values->[$ntype_attribute_idx->{$_}];
}
- my $ntype_name = $ntype_def->{name};
+ my $ntype_name = lc($ntype_def->{name});
my $ntype_num = $ntype_def->{num};
push(@ntype_names, $ntype_name);
@@ -2533,43 +2797,36 @@
$ntype_def->{literal_suffix} = "" if (! defined $ntype_def->{literal_suffix});
$ntype_def->{quoted} = ($ntype_def->{literal_prefix} ne "" || $ntype_def->{literal_suffix} ne "");
-
# translate a native type into a repository type
- $ntype_def->{type} = (sub { local($_) = shift;
- (/char/ || /^enum$/ || /^set$/ ) && return "string";
- (/text/ ) && return "text";
- (/int/ || /^year$/ ) && return "integer";
- (/decimal/ || /float/ || /double/ ) && return "float";
- (/datetime/ || /timestamp/ ) && return "datetime";
- (/time/ ) && return "time";
- (/date/ ) && return "date";
- (/blob/ || /binary/ ) && return "binary";
- # warn "Unknown type $_";
- })->($ntype_name);
-
+ $ntype_def->{type} = $self->_repository_type($ntype_name);
+ #printf STDERR "TYPE: ntype_name=%-30s %s\n", $ntype_name, join("|", %$ntype_def);
}
$self->{native}{types} = \@ntype_names;
- #########################################################
- # DATABASE ATTRIBUTES
- #########################################################
- # REMOVE ALL DEPENDENCE ON DBIx::Compat
- # $self->{native}{support_join} = DBIx::Compat::GetItem($dbdriver, "SupportJoin");
- # $self->{native}{inner_join_syntax} = DBIx::Compat::GetItem($dbdriver, "SupportSQLJoin");
- # $self->{native}{inner_join_only2tables} = DBIx::Compat::GetItem($dbdriver, "SQLJoinOnly2Tabs");
- # $self->{native}{have_types} = DBIx::Compat::GetItem($dbdriver, "HaveTypes");
- # $self->{native}{null_operator} = DBIx::Compat::GetItem($dbdriver, "NullOperator");
- # $self->{native}{need_null_in_create} = DBIx::Compat::GetItem($dbdriver, "NeedNullInCreate");
- # $self->{native}{empty_is_null} = DBIx::Compat::GetItem($dbdriver, "EmptyIsNull");
+ &App::sub_exit() if ($App::trace);
+}
+sub _repository_type {
+ &App::sub_entry if ($App::trace);
+ my ($self, $ntype_name) = @_;
+ my $rep_type = "string";
+ $_ = lc($ntype_name);
+ if (/char/ || /^enum$/ || /^set$/ || /^clob$/) { $rep_type = "string"; }
+ elsif (/text/ ) { $rep_type = "text"; }
+ elsif (/int/ || /^year$/ ) { $rep_type = "integer"; }
+ elsif (/decimal/ || /float/ || /double/ ) { $rep_type = "float"; }
+ elsif (/datetime/ || /timestamp/ ) { $rep_type = "datetime"; }
+ elsif (/time/ ) { $rep_type = "time"; }
+ elsif (/date/ ) { $rep_type = "date"; }
+ elsif (/blob/ || /binary/ || /raw/ || /bfile/ ) { $rep_type = "binary"; }
&App::sub_exit() if ($App::trace);
+ return($rep_type);
}
sub _load_table_metadata_from_source {
&App::sub_entry if ($App::trace);
my ($self, $table) = @_;
-
return if (! $table);
my ($dbdriver, $dbh, $sth, $native_table, $table_def);
@@ -2603,19 +2860,42 @@
#########################################################
# COLUMN DATA
#########################################################
- my ($colnum, $data_types, $columns, $column_def, $phys_columns);
- my ($native_type_num, $native_type_def, $phys_table);
+ my ($colnum, $data_type_names, $data_types, $columns, $column_def, $phys_columns);
+ my ($native_type_name, $native_type_num, $native_type_def, $phys_table);
+
+ $sth = $dbh->column_info($self->_column_metadata_specifiers($table));
+ $table_def->{phys_table} = $table;
- # REMOVE ALL DEPENDENCE ON DBIx::Compat
- # (ok. I want to, but I'm not ready to rewrite ListFields.)
- $func = DBIx::Compat::GetItem($dbdriver, "ListFields");
+ my $TABLE_CAT = 0; my $TABLE_SCHEM = 1;
+ my $TABLE_NAME = 2; my $COLUMN_NAME = 3;
+ my $DATA_TYPE = 4; my $TYPE_NAME = 5;
+ my $COLUMN_SIZE = 6; my $BUFFER_LENGTH = 7;
+ my $DECIMAL_DIGITS = 8; my $NUM_PREC_RADIX = 9;
+ my $NULLABLE = 10; my $REMARKS = 11;
+ my $COLUMN_DEF = 12; my $SQL_DATA_TYPE = 13;
+ my $SQL_DATETIME_SUB = 14; my $CHAR_OCTET_LENGTH = 15;
+ my $ORDINAL_POSITION = 16; my $IS_NULLABLE = 17;
+
+ my ($columns_metadata);
eval {
- $sth = &{$func}($dbh, $table);
+ $columns_metadata = $sth->fetchall_arrayref();
+ $columns_metadata = [ sort { $a->[$ORDINAL_POSITION] <=> $b->[$ORDINAL_POSITION] } @$columns_metadata ];
};
- if (!$@) {
- $table_def->{phys_table} = $table;
- $phys_columns = $sth->{NAME}; # array of fieldnames
- $data_types = $sth->{TYPE}; # array of fieldtypes
+ if (!$@ && $columns_metadata && $#$columns_metadata > -1) {
+
+ $phys_columns = [];
+ $data_types = [];
+ $data_type_names = [];
+
+ my ($column_metadata);
+ foreach $column_metadata (@$columns_metadata) {
+ push (@$phys_columns, $column_metadata->[$COLUMN_NAME]);
+ push (@$data_types, $column_metadata->[$DATA_TYPE]);
+ push (@$data_type_names, lc($column_metadata->[$TYPE_NAME]));
+ $column = lc($column_metadata->[$COLUMN_NAME]);
+ $table_def->{column}{$column}{metadata} = $column_metadata;
+ #print STDERR "TABLE COLUMNS: $column [", join("|", @$column_metadata), "]\n";
+ }
$columns = $table_def->{columns};
if (! defined $columns) {
@@ -2623,6 +2903,7 @@
$table_def->{columns} = $columns;
}
+ my $datetime_regexp = $self->{datetime_regexp};
# if we got a list of columns for the table from the database
if (defined $phys_columns && ref($phys_columns) eq "ARRAY") {
@@ -2638,8 +2919,10 @@
}
next if ($column_def->{hide});
- $native_type_num = $data_types->[$colnum];
- $native_type_def = $self->{native}{type}{$native_type_num};
+ $native_type_name = $data_type_names->[$colnum];
+ $native_type_num = $data_types->[$colnum];
+ $native_type_def = $self->{native}{type}{$native_type_name} || $self->{native}{type}{$native_type_num};
+ $column_metadata = $table_def->{column}{$column}{metadata};
if (! $self->{hide_physical} && ! defined $column_def->{idx}) {
push(@$columns, $column);
@@ -2647,73 +2930,79 @@
}
$column_def->{name} = $column;
- $column_def->{type} = $native_type_def->{type};
- $column_def->{stype} = $native_type_num;
+ $column_def->{type} = $native_type_def->{type} || $self->_repository_type($native_type_name);
+ if ($column_def->{type} eq "date" && $datetime_regexp && $column =~ /$datetime_regexp/) {
+ $column_def->{type} = "datetime";
+ }
+ if ($column_def->{type} eq "float" && defined $column_metadata->[$DECIMAL_DIGITS] && $column_metadata->[$DECIMAL_DIGITS] == 0) {
+ $column_def->{type} = "integer";
+ }
+
$column_def->{quoted} = $native_type_def->{quoted} ? 1 : 0;
- $column_def->{alias} = "cn$colnum" if (!defined $column_def->{alias});
- $column_def->{dbexpr} = $table_def->{alias} . "." . $column
- if (!defined $column_def->{dbexpr});
+ if (!defined $column_def->{dbexpr}) {
+ $column_def->{dbexpr} = $table_def->{alias} . "." . $column
+ }
+
+ $column_def->{sqltype} = $native_type_num;
}
}
- }
- #else {
- # die $@;
- #}
-
- ######################################################################
- # primary key
- ######################################################################
- if (!$self->{primary_key} || !$self->{alternate_key}) {
- $self->_load_table_key_metadata($table);
- }
-
- ######################################################################
- # tables that are related via tablealiases can be "import"-ed
- # this copies all of the column definitions from the imported table to this table
- # TODO: allow for role modifiers in related tables
- # TODO: rethink "import=1" to "multiplicity=1"
- # TODO: think about chained imports
- # TODO: think about import on demand rather than in advance
- ######################################################################
- my ($tablealiases, $alias, $alias_def, $related_table, $related_table_def);
- my ($tablealias_defs, $tablealias_def, $idx);
-
- $tablealiases = $table_def->{tablealiases};
- if (defined $tablealiases && ref($tablealiases) eq "ARRAY") {
- foreach $alias (@$tablealiases) {
- $alias_def = $table_def->{tablealias}{$alias};
- if ($alias_def->{import}) {
- $related_table = $alias_def->{table};
- if (! $self->{table}{$related_table}{loaded}) {
- $self->_load_table_metadata($related_table);
- }
- $related_table_def = $self->{table}{$related_table};
- foreach $column (@{$related_table_def->{columns}}) {
- if (! defined $table_def->{column}{$column} &&
- defined $related_table_def->{column}{$column}) {
- $table_def->{column}{$column} = $related_table_def->{column}{$column};
+ ######################################################################
+ # primary key
+ ######################################################################
+
+ if ($table_def->{phys_table}) {
+ $table_def->{primary_key} = $self->_get_primary_key_from_source($table) if (!$table_def->{primary_key});
+ $table_def->{alternate_key} = $self->_get_alternate_keys_from_source($table) if (!$table_def->{alternate_key});
+ }
+
+ ######################################################################
+ # tables that are related via tablealiases can be "import"-ed
+ # this copies all of the column definitions from the imported table to this table
+ # TODO: allow for role modifiers in related tables
+ # TODO: rethink "import=1" to "multiplicity=1"
+ # TODO: think about chained imports
+ # TODO: think about import on demand rather than in advance
+ ######################################################################
+ my ($tablealiases, $alias, $alias_def, $related_table, $related_table_def);
+ my ($tablealias_defs, $tablealias_def, $idx);
+
+ $tablealiases = $table_def->{tablealiases};
+ if (defined $tablealiases && ref($tablealiases) eq "ARRAY") {
+ foreach $alias (@$tablealiases) {
+ $alias_def = $table_def->{tablealias}{$alias};
+ if ($alias_def->{import}) {
+ $related_table = $alias_def->{table};
+ if (! $self->{table}{$related_table}{loaded}) {
+ $self->_load_table_metadata($related_table);
+ }
+ $related_table_def = $self->{table}{$related_table};
+ foreach $column (@{$related_table_def->{columns}}) {
+ if (! defined $table_def->{column}{$column} &&
+ defined $related_table_def->{column}{$column}) {
+ $table_def->{column}{$column} = $related_table_def->{column}{$column};
+ }
}
}
}
}
- }
-
- # for each tablealias named in the configuration, give it a number up front
- $tablealias_defs = $table_def->{tablealias};
- for ($idx = 0; $idx <= $#$tablealiases; $idx++) {
- $tablealias = $tablealiases->[$idx];
- $tablealias_defs->{$tablealias}{idx} = $idx;
- }
- # for each tablealias in the hash (random order), add them to the end
- foreach $tablealias (keys %$tablealias_defs) {
- $tablealias_def = $tablealias_defs->{$tablealias};
+ # for each tablealias named in the configuration, give it a number up front
+ $tablealias_defs = $table_def->{tablealias};
+ for ($idx = 0; $idx <= $#$tablealiases; $idx++) {
+ $tablealias = $tablealiases->[$idx];
+ $tablealias_defs->{$tablealias}{idx} = $idx;
+ }
- # table has not been added to the list and it's not explicitly "hidden", so add it
- if (!defined $tablealias_def->{idx}) {
- push(@$tablealiases, $tablealias);
- $tablealias_def->{idx} = $#$tablealiases;
+ # for each tablealias in the hash (random order), add them to the end
+ foreach $tablealias (keys %$tablealias_defs) {
+ $tablealias_def = $tablealias_defs->{$tablealias};
+
+ # table has not been added to the list and it's not explicitly "hidden", so add it
+ if (!defined $tablealias_def->{idx}) {
+ push(@$tablealiases, $tablealias);
+ $tablealias_def->{idx} = $#$tablealiases;
+ }
}
}
@@ -2761,36 +3050,75 @@
return;
}
-
-
-
sub _last_inserted_id {
my ($self, $table) = @_;
return $self->{last_inserted_id};
}
-sub _load_table_key_metadata {
- &App::sub_entry if ($App::trace);
- my ($self, $table) = @_;
+# $pk_idx = $rep->_key_idx($table, \@cols, \@key_cols);
+sub _key_idx {
+ my $self = shift;
+ my ($table, $cols, $key_cols) = @_;
- warn "No Table name", return if (! $table);
- my $table_def = $self->{table}{$table};
- warn "No Table def", return if (! $table_def);
+ if (!$key_cols) {
+ $key_cols = $self->{table}{$table}{primary_key} || [];
+ my $alternate_key = $self->{table}{$table}{alternate_key};
+ if ($alternate_key && $#$alternate_key > -1) {
+ foreach my $ak (@$alternate_key) {
+ push(@$key_cols, @$ak);
+ }
+ }
+ }
- if (!$table_def->{phys_table}) {
- &App::sub_exit() if ($App::trace);
- return();
+ my $key_idx = [];
+ if ($#$key_cols == 0) {
+ my $key_column = $key_cols->[0];
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ if ($cols->[$i] eq $key_column) {
+ $key_idx = [ $i ];
+ last;
+ }
+ }
}
- my $dbh = $self->{dbh};
- # if not defined at all, try to get it from the database
- #$self->{dbcatalog} ||=$self->{dbname};
- $self->{dbschema} ||= $self->{dbname} if $self->{dbdriver} eq 'Oracle';
- if (! defined $table_def->{primary_key}) {
- eval {
- $table_def->{primary_key} = [ map {lc} $dbh->primary_key($self->{dbcatalog}, $self->{dbschema}, $table) ];
- }; if ($@) {die $@}
+ else {
+ my (%colidx, $key_column);
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $colidx{$cols->[$i]} = $i;
+ }
+ for (my $i = 0; $i <= $#$key_cols; $i++) {
+ $key_column = $key_cols->[$i];
+ if (defined $colidx{$key_column}) {
+ push(@$key_idx, $i);
+ }
+ }
}
- &App::sub_exit() if ($App::trace);
+ return($key_idx);
+}
+
+sub _get_tables_from_source {
+ my ($self) = @_;
+ my $dbh = $self->{dbh};
+ my @tables = map {lc} grep(s/^[^.]+\.//, grep(s/['"`]//g, $dbh->tables("%","%","%","TABLE,VIEW")));
+ return(@tables);
+}
+
+sub _get_primary_key_from_source {
+ my ($self, $table) = @_;
+ my $dbh = $self->{dbh};
+ my $primary_key = [ map {lc} $dbh->primary_key("%", "%", $table) ];
+ return($primary_key);
+}
+
+sub _get_alternate_keys_from_source {
+ my ($self, $table) = @_;
+ my $alternate_keys = [];
+ return($alternate_keys);
+}
+
+sub _column_metadata_specifiers {
+ my ($self, $table) = @_;
+ # catalog, schema, table, column
+ return("%", "%", $table, "%");
}
1;
Modified: p5ee/trunk/App-Repository/lib/App/Repository/MySQL.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository/MySQL.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository/MySQL.pm Mon Nov 10 15:22:53 2008
@@ -444,36 +444,6 @@
return($nrows);
}
-sub _load_table_key_metadata {
- &App::sub_entry if ($App::trace);
- my ($self, $table) = @_;
-
- return if (! $table);
- my $table_def = $self->{table}{$table};
- return if (! $table_def);
-
- $self->SUPER::_load_table_key_metadata($table);
- my $dbh = $self->{dbh};
-
- # if not defined at all, try to get it from the database
- if ($table_def->{phys_table} && (! defined $table_def->{primary_key} ||
- !defined $table_def->{alternate_key}))
- {
- my $unique;
-
- local $dbh->{FetchHashKeyName} = 'NAME_lc';
- (my $sth = $dbh->prepare("SHOW INDEX FROM $table"))->execute();
- for my $idx (@{$sth->fetchall_arrayref({})}) {
- next if ('PRIMARY' eq $idx->{key_name}); # SUPER handles.
- if (!($idx->{Non_unique})) {
- push @{$unique->{$idx->{key_name}}},$idx->{column_name};
- }
- }
- $table_def->{alternate_key} = [values %$unique];
- }
- &App::sub_exit() if ($App::trace);
-}
-
#############################################################################
# METHODS
#############################################################################
@@ -759,5 +729,51 @@
return($e =~ /duplicate/i);
}
+sub _get_tables_from_source {
+ my ($self) = @_;
+ my $dbh = $self->{dbh};
+ my @tables = map {lc} grep(s/^[^.]+\.//, grep(s/['"`]//g, $dbh->tables(undef,$self->{dbname},"%","TABLE,VIEW")));
+ return(@tables);
+}
+
+sub _get_primary_key_from_source {
+ my ($self, $table) = @_;
+ my $dbh = $self->{dbh};
+ my $primary_key = [ map {lc} $dbh->primary_key(undef, $self->{dbname}, $table) ];
+ return($primary_key);
+}
+
+sub _get_alternate_keys_from_source {
+ my ($self, $table) = @_;
+ my $alternate_keys = [];
+ my $alternate_keys_by_name = {};
+
+ my $dbh = $self->{dbh};
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
+ my ($alternate_key);
+ (my $sth = $dbh->prepare("SHOW INDEX FROM $table"))->execute();
+ for my $index_column_def (@{$sth->fetchall_arrayref({})}) {
+ next if ('PRIMARY' eq $index_column_def->{key_name}); # SUPER handles.
+ if (!($index_column_def->{Non_unique})) {
+ $alternate_key = $alternate_keys_by_name->{$index_column_def->{key_name}};
+ if ($alternate_key) {
+ push(@$alternate_key,$index_column_def->{column_name});
+ }
+ else {
+ $alternate_key = [ $index_column_def->{column_name} ];
+ $alternate_keys_by_name->{$index_column_def->{key_name}} = $alternate_key;
+ push(@$alternate_keys, $alternate_key);
+ }
+ }
+ }
+ return($alternate_keys);
+}
+
+sub _column_metadata_specifiers {
+ my ($self, $table) = @_;
+ # catalog, schema, table, column
+ return(undef, $self->{dbname}, $table, "%");
+}
+
1;
Modified: p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm Mon Nov 10 15:22:53 2008
@@ -33,6 +33,16 @@
=cut
+sub _init2 {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @_;
+ my $context = $self->{context};
+ $context->serializer("Repository_Oracle_BLOB", class => "App::Serializer::Scalar", pack_format => "H*");
+ $self->SUPER::_init2();
+ $self->{datetime_regexp} = '_dttm$' if (!defined $self->{datetime_regexp});
+ &App::sub_exit() if ($App::trace);
+}
+
sub _dsn {
&App::sub_entry if ($App::trace);
my ($self) = @_;
@@ -71,37 +81,88 @@
return($dsn);
}
-sub _mk_where_clause {
+sub _attr {
&App::sub_entry if ($App::trace);
- my ($self, $table, $options) = @_;
- my $where = $self->SUPER::_mk_where_clause(@_[1..$#_]);
+ my ($self) = @_;
+ my $long_read_len = $self->{long_read_len} || 4000;
+ my $attr = {
+ PrintError => 0,
+ AutoCommit => 1,
+ RaiseError => 1,
+ FetchHashKeyName => 'NAME_lc',
+ LongReadLen => $long_read_len,
+ #ShowErrorStatement => 1, # this doesn't seem to include the right SQL statement. very confusing.
+ };
+ &App::sub_exit($attr) if ($App::trace);
+ return($attr);
+}
+sub _mk_where_clause {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $params, $options) = @_;
$options = {} if (!$options);
+ my @where = $self->SUPER::_mk_where_clause($table, $params, $options);
+ if ($options->{startrow}) {
+ push(@where, "rownum >= $options->{startrow}");
+ }
if ($options->{endrow}) {
- $where .= "AND rownum <= $options->{endrow}\n";
+ push(@where, "rownum <= $options->{endrow}");
+ }
+ if (wantarray) {
+ &App::sub_exit(@where) if ($App::trace);
+ return(@where);
+ }
+ else {
+ my $where = "";
+ if ($#where > -1) {
+ $where = "where " . join("\n and ", @where) . "\n";
+ }
+ &App::sub_exit($where) if ($App::trace);
+ return($where);
}
- &App::sub_exit($where) if ($App::trace);
- return($where);
}
-use Data::Dumper;
-sub _load_table_key_metadata {
+sub _load_table_metadata_from_source2 {
&App::sub_entry if ($App::trace);
my ($self, $table) = @_;
-
- return if (! $table);
- my $table_def = $self->{table}{$table};
- return if (! $table_def);
- my $dbh = $self->{dbh};
-
- $self->SUPER::_load_table_key_metadata($table);
- # $self->_load_alternate_indices();
- warn("Look for alternated indeces");
-
+ my $column_defs = $self->{table}{$table}{column};
+ my @columns = (keys %$column_defs);
+ my ($column_def, $type, $dbexpr);
+ my $table_alias = $self->{table}{$table}{alias};
+ my $default_date_format = $self->{default_date_format};
+ my $default_datetime_format = $self->{default_datetime_format} || $default_date_format;
+ foreach my $column (@columns) {
+ $column_def = $column_defs->{$column};
+ if ($column_def) {
+ #if ($column_def->{phys_column}) { # ??? #SEB
+ $type = $column_def->{type};
+ $dbexpr = "$table_alias.$column";
+ if ($type eq "date") {
+ #print STDERR "_load_table_metadata_from_source2($table): date : ($column_def->{dbexpr} eq $dbexpr && !$default_date_format)\n";
+ if ($column_def->{dbexpr} eq $dbexpr && $default_date_format ne "YYYY-MM-DD") {
+ $column_def->{dbexpr_update} = "to_date(%s,'YYYY-MM-DD')";
+ $column_def->{dbexpr} = "to_char($dbexpr,'YYYY-MM-DD')";
+ }
+ }
+ elsif ($type eq "datetime") {
+ if ($column_def->{dbexpr} eq $dbexpr && $default_datetime_format ne "YYYY-MM-DD HH24:MI:SS") {
+ $column_def->{dbexpr} = "to_char($dbexpr,'YYYY-MM-DD HH24:MI:SS')";
+ $column_def->{dbexpr_update} = "to_date(%s,'YYYY-MM-DD HH24:MI:SS')";
+ }
+ }
+ elsif ($type eq "binary") {
+ $column_def->{serializer} = "Repository_Oracle_BLOB";
+ $column_def->{deserializer} = "Repository_Oracle_BLOB";
+ }
+ #printf STDERR "_load_table_metadata_from_source2($table): %-18s [%-8s] [%-30s] [%-36s]\n", $column, $type, $column_def->{dbexpr}, $column_def->{dbexpr_update};
+ #}
+ # Hmmmm. This is an Oracle fix. DATE (TYPE 93) types need to be bound as VARCHAR2 (12).
+ $column_def->{sqltype} = 12 if (defined $column_def->{sqltype} && $column_def->{sqltype} == 93);
+ }
+ }
&App::sub_exit() if ($App::trace);
}
-
#############################################################################
# METHODS
#############################################################################
@@ -321,8 +382,36 @@
sub is_duplicate_key_error {
my ($self, $e) = @_;
- warn "Oracle-specific error messages not defined";
- return($e =~ /duplicate/i);
+ return($e =~ /ORA-00001: unique constraint/i);
+}
+
+sub _get_tables_from_source {
+ my ($self) = @_;
+ my $dbh = $self->{dbh};
+ my $dbschema = $self->{dbschema} || $self->{dbuser} || "%";
+ my @tables = map {lc} grep($_ !~ m/\$/, grep(s/^[^.]+\.//, grep(s/['"`]//g, $dbh->tables(undef,uc($dbschema),"%","TABLE,VIEW"))));
+ return(@tables);
+}
+
+sub _get_primary_key_from_source {
+ my ($self, $table) = @_;
+ my $dbh = $self->{dbh};
+ my $dbschema = $self->{dbschema} || $self->{dbuser} || "%";
+ my $primary_key = [ map {lc} $dbh->primary_key(undef, uc($dbschema), uc($table)) ];
+ return($primary_key);
+}
+
+sub _get_alternate_keys_from_source {
+ my ($self, $table) = @_;
+ my $alternate_keys = [];
+ return($alternate_keys);
+}
+
+sub _column_metadata_specifiers {
+ my ($self, $table) = @_;
+ my $dbschema = $self->{dbschema} || $self->{dbuser} || "%";
+ # catalog, schema, table, column
+ return(undef, uc($dbschema), uc($table), "%");
}
1;
Modified: p5ee/trunk/App-Repository/t/DBI-compress.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-compress.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-compress.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -53,34 +56,23 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-#cheating... I know its a DBI, but I have to set up the test somehow
-my $dbh = $rep->{dbh};
-eval { $dbh->do("drop table test_person"); };
-my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- data blob null,
- index person_ie1 (last_name, first_name)
-)
-EOF
-$dbh->do($ddl);
+my $dbtype = $App::options{dbtype} || "mysql";
+if ($dbtype eq "oracle") {
+ $rep->{table}{test_person}{column}{data}{dbexpr} = "data";
+ $rep->{table}{test_person}{column}{data}{dbexpr_update} = "%s";
+}
+
+###########################################################################################
+# Set Up the Database for the Tests
+###########################################################################################
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
my $columns = [ "person_id", "age", "first_name", "gender", "state", "birth_dt", "data" ];
my $rows = [
@@ -99,16 +91,14 @@
};
ok(!$@, "insert_rows() [test_person]");
is($nrows, 7, "insert_rows() [test_person]: wrote 7 rows");
-
my $hash = $rep->get_hash("test_person",{first_name=>"stephen"});
is($hash->{data}, "Temperament: Goofy\nTalent: Minimal", "get(data) ok");
my ($data1, $data2);
$data1 = "ouch!\nouch!";
$nrows = $rep->set("test_person",{first_name=>"stephen"},"data","ouch!\nouch!");
+
is($nrows, 1, "set() data");
$data2 = $rep->get("test_person",{first_name=>"stephen"},"data");
is($data2, $data1, "get() data");
-exit 0;
-
Modified: p5ee/trunk/App-Repository/t/DBI-connect.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-connect.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-connect.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use_ok("App");
use_ok("App::Repository");
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -40,6 +43,8 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
#print "REP: $rep\n";
@@ -63,27 +68,30 @@
ok(defined $rep->{dbh}, "dbh defined");
}
-use_ok("App::Repository::MySQL");
-
-{
- #$App::aspect = 1;
- # get a repository (no need for config file)
- my $rep = App::Repository::MySQL->new("test2",
- dbdriver => $App::options{dbdriver},
- dbhost => $App::options{dbhost},
- dbname => $App::options{dbname},
- dbuser => $App::options{dbuser},
- dbpass => $App::options{dbpass},
- );
- ok(defined $rep, "constructor ok");
- isa_ok($rep, "App::Repository::DBI", "right class");
- ok($rep->{name} eq "test2", "name ok");
- isa_ok($rep->{dbh}, "DBI::db", "dbh");
- ok($rep->_is_connected(), "connected [yes]");
- ok($rep->_disconnect(), "disconnect OK");
- ok(!$rep->_is_connected(), "connected [no]");
- ok(! defined $rep->{dbh}, "dbh undefed");
-}
+#if ($App::options{dbtype} eq "mysql") {
+ my $class = $App::options{dbclass};
+ use_ok($class);
+
+ {
+ #$App::aspect = 1;
+ # get a repository (no need for config file)
+ my $rep = $class->new("test2",
+ dbdriver => $App::options{dbdriver},
+ dbhost => $App::options{dbhost},
+ dbname => $App::options{dbname},
+ dbuser => $App::options{dbuser},
+ dbpass => $App::options{dbpass},
+ );
+ ok(defined $rep, "constructor ok");
+ isa_ok($rep, "App::Repository::DBI", "right class");
+ ok($rep->{name} eq "test2", "name ok");
+ isa_ok($rep->{dbh}, "DBI::db", "dbh");
+ ok($rep->_is_connected(), "connected [yes]");
+ ok($rep->_disconnect(), "disconnect OK");
+ ok(!$rep->_is_connected(), "connected [no]");
+ ok(! defined $rep->{dbh}, "dbh undefed");
+ }
+#}
exit 0;
Modified: p5ee/trunk/App-Repository/t/DBI-delete.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-delete.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-delete.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -52,40 +55,17 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-#cheating... I know its a DBI, but I have to set up the test somehow
-my $dbh = $rep->{dbh};
-eval { $dbh->do("drop table test_person"); };
-my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
-$dbh->do($ddl);
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
+
+my $dbtype = $App::options{dbtype} || "mysql";
my $columns = [ "person_id", "age", "first_name", "gender", "state", "birth_dt" ];
@@ -94,7 +74,7 @@
my ($nrows);
eval {
- $nrows = $dbh->do($sql);
+ $nrows = $rep->_do($sql);
};
is($@,"","sql ok");
@@ -207,31 +187,32 @@
$sql = $rep->_mk_delete_sql("test_person", { "birth_dow" => "1,7" });
is($sql, $expect_sql, "_mk_delete_sql(): dbexpr");
-$expect_sql = <<EOF;
+if ($dbtype eq 'mysql') {
+ $expect_sql = <<EOF;
delete from test_person
where birth_dt >= '1960-01-01'
and birth_dt <= '1965-12-31'
EOF
-$sql = $rep->_mk_delete_sql("test_person",
- {
- _order => [ "begin_birth_dt", "end_birth_dt" ],
- "begin_birth_dt" => "1960-01-01",
- "end_birth_dt" => "1965-12-31",
- });
-is($sql, $expect_sql, "_mk_delete_sql(): begin/end params (quoted)");
+ $sql = $rep->_mk_delete_sql("test_person",
+ {
+ _order => [ "begin_birth_dt", "end_birth_dt" ],
+ "begin_birth_dt" => "1960-01-01",
+ "end_birth_dt" => "1965-12-31",
+ });
+ is($sql, $expect_sql, "_mk_delete_sql(): begin/end params (quoted)");
-$expect_sql = <<EOF;
+ $expect_sql = <<EOF;
delete from test_person
where birth_dt >= '19600101'
and birth_dt <= '19651231'
EOF
-$sql = $rep->_mk_delete_sql("test_person",
- {
- _order => [ "begin_birth_dt", "end_birth_dt" ],
- "begin_birth_dt" => "19600101",
- "end_birth_dt" => "19651231",
- });
-is($sql, $expect_sql, "_mk_delete_sql(): begin/end params (unquoted)");
-
+ $sql = $rep->_mk_delete_sql("test_person",
+ {
+ _order => [ "begin_birth_dt", "end_birth_dt" ],
+ "begin_birth_dt" => "19600101",
+ "end_birth_dt" => "19651231",
+ });
+ is($sql, $expect_sql, "_mk_delete_sql(): begin/end params (unquoted)");
+}
exit 0;
Modified: p5ee/trunk/App-Repository/t/DBI-expr.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-expr.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-expr.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -57,43 +60,18 @@
},
},
},
- #debug_sql => 1,
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,40,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+###########################################################################################
+# Set Up the Database for the Tests
+###########################################################################################
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
###########################################################################
# DATA ACCESS TESTS
@@ -102,15 +80,6 @@
my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
-my $rows = [
- [ 1, 40, "stephen", "M", "GA", ],
- [ 2, 37, "susan", "F", "GA", ],
- [ 3, 6, "maryalice", "F", "GA", ],
- [ 4, 3, "paul", "M", "GA", ],
- [ 5, 1, "christine", "F", "GA", ],
- [ 6, 45, "tim", "M", "GA", ],
- [ 7, 39, "keith", "M", "GA", ],
-];
#####################################################################
# $value = $rep->get ($table, $key, $col, \%options);
@@ -120,20 +89,20 @@
my ($row, $rows, $hash, $hashes, $objects, $object, $nrows);
my ($age, $age_sq, $wisdom_score, $public_age);
$age = $rep->get("test_person",1,"age");
- is($age, 40, "get(age)");
+ is($age, 39, "get(age)");
$age_sq = $rep->get("test_person",1,"age_sq");
- is($age_sq, 1600, "get(age_sq)");
+ is($age_sq, 1521, "get(age_sq)");
$wisdom_score = $rep->get("test_person",1,"wisdom_score");
- is($wisdom_score, 80, "get(wisdom_score)");
+ is($wisdom_score, 76.05, "get(wisdom_score)");
my @cols = ("wisdom_score");
$rows = $rep->get_rows("test_person",1,\@cols);
$row = $rows->[0];
- is($row->[0], 80, "get_rows(wisdom_score)");
+ is($row->[0], 76.05, "get_rows(wisdom_score)");
$hashes = $rep->get_hashes("test_person",1,\@cols);
$hash = $hashes->[0];
- is($hash->{wisdom_score}, 80, "get_hashes(wisdom_score)");
+ is($hash->{wisdom_score}, 76.05, "get_hashes(wisdom_score)");
$objects = $rep->get_objects("test_person",1,\@cols);
$object = $objects->[0];
- is($object->{wisdom_score}, 80, "get_objects(wisdom_score)");
+ is($object->{wisdom_score}, 76.05, "get_objects(wisdom_score)");
}
Modified: p5ee/trunk/App-Repository/t/DBI-getset-cache.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-getset-cache.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-getset-cache.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person create_table_test_app_cache);
use strict;
if (!$App::options{dbuser}) {
@@ -52,7 +55,7 @@
class => "App::SharedDatastore::Repository",
compress => 1,
repository => "default",
- table => "app_cache",
+ table => "test_app_cache",
cache_type => "dbquery",
cache_type_column => "cache_type",
cache_key_column => "cache_key",
@@ -64,60 +67,18 @@
},
},
debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
-
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
-
- eval { $dbh->do("drop table if exists app_cache"); };
- $ddl = <<EOF;
-create table app_cache (
- cache_type varchar(16) not null,
- cache_key varchar(40) not null,
- generate_dttm datetime default null,
- serializer varchar(12) default null,
- serialization_args varchar(64) default null,
- data longblob,
- modify_dttm timestamp not null default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
- PRIMARY KEY (cache_type,cache_key),
- KEY app_cache_ie1 (modify_dttm)
-) ENGINE=InnoDB DEFAULT CHARSET=latin1
-EOF
- $dbh->do($ddl);
-
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','FL')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+###########################################################################################
+# Set Up the Database for the Tests
+###########################################################################################
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&create_table_test_app_cache($rep);
+&populate_table_test_person($rep);
###########################################################################
# DATA ACCESS TESTS
@@ -132,7 +93,7 @@
[ 3, 6, "maryalice", "F", "GA", ],
[ 4, 3, "paul", "M", "GA", ],
[ 5, 1, "christine", "F", "GA", ],
- [ 6, 45, "tim", "M", "FL", ],
+ [ 6, 45, "tim", "M", "GA", ],
[ 7, 39, "keith", "M", "GA", ],
];
@@ -142,13 +103,14 @@
# $value = $rep->get ($table, $key, $col, \%options);
# $rep->set($table, $key, $col, $value, \%options);
#####################################################################
-$data_rows = $rep->get_rows("test_person", {}, ["state"], {order_by=>["person_id"]});
+$data_rows = $rep->get_rows("test_person", {}, ["state"], {order_by=>["person_id"]});
$first_name = $rep->get("test_person", 1, "first_name");
is($first_name, "stephen", "get() first_name [$first_name]");
+
is($rep->set("test_person", 1, "first_name", "steve"),1,"set() first name [steve]");
$first_name = $rep->get("test_person", 1, "first_name");
is($first_name, "stephen", "get() modified first_name [$first_name] got cache instead");
-#exit(0);
+
$first_name = $rep->get("test_person", {person_id => 1}, "first_name");
is($first_name, "steve", "get() modified first_name [$first_name]");
$age = $rep->get("test_person", 1, "age");
@@ -198,7 +160,9 @@
is($first_name, "steve", "get() modified first_name [$first_name] by skipping the cache");
$data_rows = $rep->get_rows("test_person", {}, [ "person_id", "age", "first_name", "gender", "state" ], {order_by=>["person_id"], cache_refresh => 1});
+exit;
is_deeply($data_rows, $data_rows2, "get_rows() refreshed cached data thanks to cache_refresh");
+
$first_name = $rep->get("test_person", 1, "first_name", { cache_refresh => 1 });
is($first_name, "steve", "get() modified first_name [$first_name] by refreshing the cache");
@@ -207,10 +171,5 @@
$first_name = $rep->get("test_person", 1, "first_name");
is($first_name, "steve", "get() modified first_name [$first_name] confirming that the cache was refreshed");
-{
- my $dbh = $rep->{dbh};
- $dbh->do("drop table test_person");
-}
-
exit 0;
Modified: p5ee/trunk/App-Repository/t/DBI-getset-realtable.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-getset-realtable.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-getset-realtable.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -41,73 +44,26 @@
table => {
test_person => {
primary_key => ["person_id"],
- alias => "tp",
- tablealiases => [ "tp" ],
- tablealias => {
- tp => {
- table => "test.test_person",
- },
- },
+ alias => "tp",
+ tablealiases => [ "tp" ],
+ tablealias => {
+ tp => {
+ table => "test_person",
+ },
+ },
},
},
},
},
},
debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
-
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
-
- eval { $dbh->do("drop table if exists app_cache"); };
- $ddl = <<EOF;
-create table app_cache (
- cache_type varchar(16) not null,
- cache_key varchar(40) not null,
- generate_dttm datetime default null,
- serializer varchar(12) default null,
- serialization_args varchar(64) default null,
- data longblob,
- modify_dttm timestamp not null default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
- PRIMARY KEY (cache_type,cache_key),
- KEY app_cache_ie1 (modify_dttm)
-) ENGINE=InnoDB DEFAULT CHARSET=latin1
-EOF
- $dbh->do($ddl);
-
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','FL')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
###########################################################################
# DATA ACCESS TESTS
@@ -199,8 +155,7 @@
is($first_name, "steve", "get() modified first_name [$first_name] confirming that the cache was refreshed");
{
- my $dbh = $rep->{dbh};
- $dbh->do("drop table test_person");
+ &drop_table_test_person($rep);
}
exit 0;
Modified: p5ee/trunk/App-Repository/t/DBI-getset.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-getset.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-getset.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -52,42 +55,14 @@
},
},
debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','FL')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
+$rep->set("test_person",6,"state","FL");
###########################################################################
# DATA ACCESS TESTS
@@ -194,7 +169,6 @@
#foreach my $row (@$rows2) {
# print "ROW: [", join("|", map { defined $_ ? $_ : "undef" } @$row), "]\n";
#}
-
$hashes = $rep->get_hashes("test_person", {first_name => "!steve,joe,nick"});
is($#$hashes+1, 6, "get_hashes(!steve,joe,nick)");
$hashes = $rep->get_hashes("test_person", {first_name => "steve,joe,nick"});
@@ -225,14 +199,12 @@
is($#$hashes+1, 6, "get_hashes contains (A)");
$hashes = $rep->get_hashes("test_person", {"state.not_contains" => "A"});
is($#$hashes+1, 1, "get_hashes not_contains (A)");
-
$hashes = $rep->get_hashes("test_person", {"state.matches" => "?A"});
is($#$hashes+1, 6, "get_hashes matches (?A)");
$hashes = $rep->get_hashes("test_person", {"state" => "?A"});
is($#$hashes+1, 6, "get_hashes (?A)");
$hashes = $rep->get_hashes("test_person", {"state.not_matches" => "?A"});
is($#$hashes+1, 1, "get_hashes not_matches (?A)");
-
#print $rep->{sql};
#####################################################################
Modified: p5ee/trunk/App-Repository/t/DBI-import.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-import.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-import.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use_ok("App");
use_ok("App::Repository");
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -53,73 +56,64 @@
# my $options= $context->{options};
# print "OPTIONS: {", join("|", %$options), "}\n";
-my $db = $context->repository();
+my $rep = $context->repository();
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+
+my $dbtype = $App::options{dbtype} || "mysql";
my $t_dir = "t";
$t_dir = "." if (! -d $t_dir);
{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $db->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
- $db->_load_rep_metadata();
-}
+ $rep->_load_rep_metadata();
-{
- is($db->insert_rows("test_person", ["person_id","age","first_name","gender","state"],
- [[1,39,"stephen", "M","GA"],
- [2,37,"susan", "F","GA"]]),2,
- "insert rows (2 rows, primary key included)");
- is($db->get("test_person",1,"first_name"), "stephen", "1st row got in [stephen]");
- is($db->get("test_person",2,"first_name"), "susan", "2nd row got in [susan]");
+ if ($dbtype eq "mysql") {
+ is($rep->insert_rows("test_person", ["person_id","age","first_name","gender","state"],
+ [[1,39,"stephen", "M","GA"],
+ [2,37,"susan", "F","GA"]]),2,
+ "insert rows (2 rows, primary key included)");
+ }
+ elsif ($dbtype eq "oracle") {
+ is($rep->insert_rows("test_person", ["age","first_name","gender","state"],
+ [[39,"stephen", "M","GA"],
+ [37,"susan", "F","GA"]]),2,
+ "insert rows (2 rows, primary key included)");
+ }
- is($db->import_rows("test_person", ["age","first_name","gender","state"],
+ is($rep->get("test_person",1,"first_name"), "stephen", "1st row got in [stephen]");
+ is($rep->get("test_person",2,"first_name"), "susan", "2nd row got in [susan]");
+
+ is($rep->import_rows("test_person", ["age","first_name","gender","state"],
"$t_dir/files/DBI-import.01.dat", {field_sep => "|", import_method => "insert"}),
120,
"import from file [files/DBI-import.01.dat]");
- is($db->get("test_person",3,"first_name"), "mike", "3rd row got in [mike]");
- is($db->get("test_person",4,"first_name"), "mary", "4th row got in [mary]");
- is($db->get("test_person",5,"first_name"), "maxwell", "5th row got in [maxwell]");
- is($db->get("test_person",6,"first_name"), "myrtle", "6th row got in [myrtle]");
-}
-__END__
+ is($rep->get("test_person",3,"first_name"), "mike", "3rd row got in [mike]");
+ is($rep->get("test_person",4,"first_name"), "mary", "4th row got in [mary]");
+ is($rep->get("test_person",5,"first_name"), "maxwell", "5th row got in [maxwell]");
+ is($rep->get("test_person",6,"first_name"), "myrtle", "6th row got in [myrtle]");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ ok($rep->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
[undef, 6,"maryalice","F","GA"]),
"insert row (primary key included, null)");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ ok($rep->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
[0, 3,"paul", "M","GA"]),
"insert row (primary key included, 0)");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+
+}
+__END__
+
+ ok($rep->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
[5, 1,"christine","F","GA"]),
"insert again");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ ok($rep->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
[6,45,"tim", "M","GA"]),
"insert again");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ ok($rep->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
[7,39,"keith", "M","GA"]),
"insert again");
- ok($db->insert("test_person", {
+
+ ok($rep->insert("test_person", {
person_id => 8,
age => 35,
first_name => "alex",
@@ -128,7 +122,7 @@
}),
"insert hash");
eval {
- $db->insert_row("test_person", {
+ $rep->insert_row("test_person", {
person_id => 8,
age => 35,
first_name => "alex",
@@ -137,7 +131,7 @@
});
};
ok($@, "insert dup hash fails");
- ok($db->insert("test_person", undef, {
+ ok($rep->insert("test_person", undef, {
person_id => 9,
age => 35,
first_name => "alex",
@@ -145,7 +139,7 @@
state => "GA",
}),
"insert hash in 2nd pos");
- ok($db->insert("test_person", ["age","first_name","gender","state"], {
+ ok($rep->insert("test_person", ["age","first_name","gender","state"], {
person_id => 9,
age => 35,
first_name => "alex",
@@ -154,7 +148,7 @@
}),
"insert hash in 2nd pos w/ col spec");
eval {
- $db->insert_row("test_person", undef, {
+ $rep->insert_row("test_person", undef, {
person_id => 9,
age => 35,
first_name => "alex",
@@ -163,8 +157,7 @@
});
};
ok($@, "insert dup hash in 2nd pos fails");
-
- ok($db->insert("test_person", undef, {
+ ok($rep->insert("test_person", undef, {
person_id => 11,
age => 999,
first_name => '%@$\\\'',
@@ -172,7 +165,7 @@
state => "GA",
}),
"insert \\ and ' and \\' seems to work");
- is($db->get("test_person",11,"first_name"),'%@$\\\'', "yep. first_name worked.");
+ is($rep->get("test_person",11,"first_name"),'%@$\\\'', "yep. first_name worked.");
}
exit 0;
Modified: p5ee/trunk/App-Repository/t/DBI-insert.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-insert.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-insert.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use_ok("App");
use_ok("App::Repository");
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -46,146 +49,128 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $db = $context->repository();
-
-$App::trace = 0;
-$App::trace = 0;
+&drop_table_test_person($db);
+&create_table_test_person($db);
{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $db->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
$db->_load_rep_metadata();
-}
-{
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
- [1,39,"stephen", "M","GA"]),
- "insert row (primary key included)");
- ok($db->_insert_row("test_person", ["age","first_name","gender","state"],
- [37,"susan", "F","GA"]),
- "insert row (primary key excluded, auto_increment)");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
- [undef, 6,"maryalice","F","GA"]),
- "insert row (primary key included, null)");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
- [0, 3,"paul", "M","GA"]),
- "insert row (primary key included, 0)");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
- [5, 1,"christine","F","GA"]),
- "insert again");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
- [6,45,"tim", "M","GA"]),
- "insert again");
- ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
- [7,39,"keith", "M","GA"]),
- "insert again");
- ok($db->insert("test_person", {
- person_id => 8,
- age => 35,
- first_name => "alex",
- gender => "M",
- state => "GA",
- }),
- "insert hash");
- eval {
- $db->insert_row("test_person", {
- person_id => 8,
- age => 35,
- first_name => "alex",
- gender => "M",
- state => "GA",
- });
- };
- ok($@, "insert dup hash fails");
- ok($db->insert("test_person", undef, {
- person_id => 9,
- age => 35,
- first_name => "alex",
- gender => "M",
- state => "GA",
- }),
- "insert hash in 2nd pos");
- ok($db->insert("test_person", ["age","first_name","gender","state"], {
- person_id => 9,
- age => 35,
- first_name => "alex",
- gender => "M",
- state => "GA",
- }),
- "insert hash in 2nd pos w/ col spec");
- eval {
- $db->insert_row("test_person", undef, {
- person_id => 9,
- age => 35,
- first_name => "alex",
- gender => "M",
- state => "GA",
- });
- };
- ok($@, "insert dup hash in 2nd pos fails");
-
- ok($db->insert("test_person", undef, {
- person_id => 11,
- age => 999,
- first_name => '%@$\\\'',
- gender => "M",
- state => "GA",
- }),
- "insert \\ and ' and \\' seems to work");
- is($db->get("test_person",11,"first_name"),'%@$\\\'', "yep. first_name worked.");
-
- my $new_hashes =
- [{ age=>39, first_name=>"stephen", gender=>"M", state=>"GA", foo=>"bar"},
- { age=>37, first_name=>"susan", gender=>"F", state=>"GA", foo=>"bar"},
- { age=>6, first_name=>"maryalice", gender=>"F", state=>"GA", foo=>"bar"},
- { age=>3, first_name=>"paul", gender=>"M", state=>"GA", foo=>"bar"},
- { age=>1, first_name=>"christine", gender=>"F", state=>"GA", foo=>"bar"},
- { age=>45, first_name=>"tim", gender=>"M", state=>"GA", foo=>"bar"},
- { age=>39, first_name=>"keith", gender=>"M", state=>"GA", foo=>"bar"},];
-
- my $new_rows =
- [[39,"stephen", "M","GA"],
- [37,"susan", "F","GA"],
- [6,"maryalice", "F","GA"],
- [3,"paul", "M","GA"],
- [1,"christine", "F","GA"],
- [45,"tim", "M","GA"],
- [39,"keith", "M","GA"],];
-
- my $dup_rows =
- [[1, 39,"stephen", "M","GA"],
- [2, 37,"susan", "F","GA"],
- [3, 6,"maryalice", "F","GA"],
- [4, 3,"paul", "M","GA"],
- [5, 1,"christine", "F","GA"],
- [6, 45,"tim", "M","GA"],
- [7, 39,"keith", "M","GA"],];
+ my $dbtype = $App::options{dbtype};
+ if ($dbtype eq "oracle") {
+ ok(1, "These tests are not for Oracle");
+ }
+ else {
+ ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ [1,39,"stephen", "M","GA"]),
+ "insert row (primary key included)");
+ ok($db->_insert_row("test_person", ["age","first_name","gender","state"],
+ [37,"susan", "F","GA"]),
+ "insert row (primary key excluded, auto_increment)");
+ ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ [undef, 6,"maryalice","F","GA"]),
+ "insert row (primary key included, null)");
+ ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ [0, 3,"paul", "M","GA"]),
+ "insert row (primary key included, 0)");
+ ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ [5, 1,"christine","F","GA"]),
+ "insert again");
+ ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ [6,45,"tim", "M","GA"]),
+ "insert again");
+ ok($db->_insert_row("test_person", ["person_id","age","first_name","gender","state"],
+ [7,39,"keith", "M","GA"]),
+ "insert again");
+ ok($db->insert("test_person", {
+ person_id => 8,
+ age => 35,
+ first_name => "alex",
+ gender => "M",
+ state => "GA",
+ }),
+ "insert hash");
+ eval {
+ $db->insert_row("test_person", {
+ person_id => 8,
+ age => 35,
+ first_name => "alex",
+ gender => "M",
+ state => "GA",
+ });
+ };
+ ok($@, "insert dup hash fails");
+ ok($db->insert("test_person", undef, {
+ person_id => 9,
+ age => 35,
+ first_name => "alex",
+ gender => "M",
+ state => "GA",
+ }),
+ "insert hash in 2nd pos");
+ ok($db->insert("test_person", ["age","first_name","gender","state"], {
+ person_id => 9,
+ age => 35,
+ first_name => "alex",
+ gender => "M",
+ state => "GA",
+ }),
+ "insert hash in 2nd pos w/ col spec");
+ eval {
+ $db->insert_row("test_person", undef, {
+ person_id => 9,
+ age => 35,
+ first_name => "alex",
+ gender => "M",
+ state => "GA",
+ });
+ };
+ ok($@, "insert dup hash in 2nd pos fails");
+
+ ok($db->insert("test_person", undef, {
+ person_id => 12,
+ age => 999,
+ first_name => '%@$\\\'',
+ gender => "M",
+ state => "GA",
+ }),
+ "insert \\ and ' and \\' seems to work");
+
+ is($db->get("test_person",12,"first_name"),'%@$\\\'', "yep. first_name worked.");
+
+ my $new_hashes =
+ [{ age=>39, first_name=>"stephen", gender=>"M", state=>"GA", foo=>"bar"},
+ { age=>37, first_name=>"susan", gender=>"F", state=>"GA", foo=>"bar"},
+ { age=>6, first_name=>"maryalice", gender=>"F", state=>"GA", foo=>"bar"},
+ { age=>3, first_name=>"paul", gender=>"M", state=>"GA", foo=>"bar"},
+ { age=>1, first_name=>"christine", gender=>"F", state=>"GA", foo=>"bar"},
+ { age=>45, first_name=>"tim", gender=>"M", state=>"GA", foo=>"bar"},
+ { age=>39, first_name=>"keith", gender=>"M", state=>"GA", foo=>"bar"},];
+
+ my $new_rows =
+ [[39,"stephen", "M","GA"],
+ [37,"susan", "F","GA"],
+ [6,"maryalice", "F","GA"],
+ [3,"paul", "M","GA"],
+ [1,"christine", "F","GA"],
+ [45,"tim", "M","GA"],
+ [39,"keith", "M","GA"],];
+
+ my $dup_rows =
+ [[1, 39,"stephen", "M","GA"],
+ [2, 37,"susan", "F","GA"],
+ [3, 6,"maryalice", "F","GA"],
+ [4, 3,"paul", "M","GA"],
+ [5, 1,"christine", "F","GA"],
+ [6, 45,"tim", "M","GA"],
+ [7, 39,"keith", "M","GA"],];
- my ($expect_sql, $sql);
-$expect_sql = <<EOF;
+ my ($expect_sql, $sql);
+ $expect_sql = <<EOF;
insert into test_person
(age, first_name, gender, state)
values
@@ -197,12 +182,12 @@
(45, 'tim', 'M', 'GA'),
(39, 'keith', 'M', 'GA')
EOF
-$sql = $db->_mk_insert_rows_sql("test_person", ["age","first_name","gender","state"], $new_rows);
-is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk insert");
-$sql = $db->_mk_insert_rows_sql("test_person", ["age","first_name","gender","state"], $new_hashes);
-is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk insert (from hashes)");
+ $sql = $db->_mk_insert_rows_sql("test_person", ["age","first_name","gender","state"], $new_rows);
+ is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk insert");
+ $sql = $db->_mk_insert_rows_sql("test_person", ["age","first_name","gender","state"], $new_hashes);
+ is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk insert (from hashes)");
-$expect_sql = <<EOF;
+ $expect_sql = <<EOF;
replace into test_person
(age, first_name, gender, state)
values
@@ -214,10 +199,10 @@
(45, 'tim', 'M', 'GA'),
(39, 'keith', 'M', 'GA')
EOF
-$sql = $db->_mk_insert_rows_sql("test_person", ["age","first_name","gender","state"], $new_rows, { replace => 1 });
-is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk replace");
+ $sql = $db->_mk_insert_rows_sql("test_person", ["age","first_name","gender","state"], $new_rows, { replace => 1 });
+ is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk replace");
-$expect_sql = <<EOF;
+ $expect_sql = <<EOF;
insert into test_person
(person_id, age, first_name, gender, state)
values
@@ -235,22 +220,20 @@
gender = values(gender),
state = values(state)
EOF
-$sql = $db->_mk_insert_rows_sql("test_person", ["person_id", "age","first_name","gender","state"], $dup_rows, { update => 1 });
-is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk insert/update");
-
-#######################################
-my ($nrows);
-$nrows = $db->insert_rows("test_person", ["age","first_name","gender","state"], $new_rows);
-is($nrows, 7, "insert_rows(): 7 rows, bulk insert");
-$nrows = $db->insert_rows("test_person", ["person_id","age","first_name","gender","state"], $dup_rows, { replace => 1 });
-is($nrows, 7, "insert_rows(): 7 rows, bulk replace");
-$nrows = $db->insert_rows("test_person", ["person_id", "age","first_name","gender","state"], $dup_rows, { update => 1 });
-is($nrows, 7, "insert_rows(): 7 rows, bulk insert/update");
-$nrows = $db->insert_rows("test_person", ["person_id","age","first_name","gender","state"], $dup_rows, { replace => 1, maxrows => 4 });
-is($nrows, 7, "insert_rows(): 7 rows, bulk replace (4 at a time)");
-$nrows = $db->insert_rows("test_person", ["person_id", "age","first_name","gender","state"], $dup_rows, { update => 1, maxrows => 4 });
-is($nrows, 7, "insert_rows(): 7 rows, bulk insert/update (4 at a time)");
-
+ $sql = $db->_mk_insert_rows_sql("test_person", ["person_id", "age","first_name","gender","state"], $dup_rows, { update => 1 });
+ is($sql, $expect_sql, "_mk_insert_rows_sql(): 7 rows, bulk insert/update");
+ my ($nrows);
+ $nrows = $db->insert_rows("test_person", ["age","first_name","gender","state"], $new_rows);
+ is($nrows, 7, "insert_rows(): 7 rows, bulk insert");
+ $nrows = $db->insert_rows("test_person", ["person_id","age","first_name","gender","state"], $dup_rows, { replace => 1 });
+ is($nrows, 7, "insert_rows(): 7 rows, bulk replace");
+ $nrows = $db->insert_rows("test_person", ["person_id", "age","first_name","gender","state"], $dup_rows, { update => 1 });
+ is($nrows, 7, "insert_rows(): 7 rows, bulk insert/update");
+ $nrows = $db->insert_rows("test_person", ["person_id","age","first_name","gender","state"], $dup_rows, { replace => 1, maxrows => 4 });
+ is($nrows, 7, "insert_rows(): 7 rows, bulk replace (4 at a time)");
+ $nrows = $db->insert_rows("test_person", ["person_id", "age","first_name","gender","state"], $dup_rows, { update => 1, maxrows => 4 });
+ is($nrows, 7, "insert_rows(): 7 rows, bulk insert/update (4 at a time)");
+ }
}
exit 0;
Modified: p5ee/trunk/App-Repository/t/DBI-metadata.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-metadata.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-metadata.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -52,66 +55,40 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $db = $context->repository();
-
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $db->{dbh};
- eval { $dbh->do("drop table if exists app_cache"); };
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- chess_rating float null,
- modify_dttm datetime null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- my $success = $dbh->do($ddl);
- #print "create table = [$success]\n";
-}
+&drop_table_test_person($db);
+&create_table_test_person($db);
###########################################################################
# METADATA TESTS
###########################################################################
my $table_names = $db->get_table_names();
-print "tables=[@$table_names]\n";
+#print "tables=", join(" ", @$table_names), "]\n";
my %tables = ( map { $_ => 1 } @$table_names );
ok(defined $tables{test_person}, "get_table_names()");
-$db->_load_rep_metadata();
$db->_load_table_metadata("test_person");
$db->_load_table_metadata("test_person2");
$db->_load_table_metadata("test_person3");
$db->_load_table_metadata("test_person4");
is_deeply($db->{table}{test_person}{primary_key}, ["person_id"], "primary_key set from db");
+
is_deeply($db->{table}{test_person2}{primary_key}, ["last_name", "first_name"], "primary_key set from config (comma-sep)");
is_deeply($db->{table}{test_person3}{primary_key}, ["person_id"], "primary_key set from config (scalar)");
is_deeply($db->{table}{test_person4}{primary_key}, ["person_id"], "primary_key set from config (scalar)");
my $tabledef = $db->get_table_def("test_person");
is($tabledef->{column}{person_id}{type}, "integer", "person_id type is integer");
-is($tabledef->{column}{first_name}{type}, "string", "first_name type is integer");
-is($tabledef->{column}{country}{type}, "string", "country type is integer");
-is($tabledef->{column}{gender}{type}, "string", "gender type is integer");
-is($tabledef->{column}{birth_dt}{type}, "date", "birth_dt type is integer");
+is($tabledef->{column}{first_name}{type}, "string", "first_name type is string");
+is($tabledef->{column}{country}{type}, "string", "country type is string");
+is($tabledef->{column}{gender}{type}, "string", "gender type is string");
+is($tabledef->{column}{birth_dt}{type}, "date", "birth_dt type is date");
is($tabledef->{column}{age}{type}, "integer", "age type is integer");
-is($tabledef->{column}{chess_rating}{type}, "float", "chess_rating type is integer");
-is($tabledef->{column}{modify_dttm}{type}, "datetime", "modify_dttm type is integer");
+is($tabledef->{column}{chess_rating}{type}, "float", "chess_rating type is float");
+is($tabledef->{column}{modify_dttm}{type}, "datetime", "modify_dttm type is datetime");
is($tabledef->{column}{person_id}{quoted}, 0, "person_id quoted is 0");
is($tabledef->{column}{first_name}{quoted}, 1, "first_name quoted is 1");
Modified: p5ee/trunk/App-Repository/t/DBI-repobjectdom.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjectdom.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjectdom.t Mon Nov 10 15:22:53 2008
@@ -13,13 +13,16 @@
);
use Test::More qw(no_plan);
-use lib "../App-Context/lib";
-use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib "../App-Context/lib";
+use lib "../../App-Context/lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -64,42 +67,14 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
###########################################################################
# DATA ACCESS TESTS
@@ -108,16 +83,6 @@
my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
-my $rows = [
- [ 1, 39, "stephen", "M", "GA", ],
- [ 2, 37, "susan", "F", "GA", ],
- [ 3, 6, "maryalice", "F", "GA", ],
- [ 4, 3, "paul", "M", "GA", ],
- [ 5, 1, "christine", "F", "GA", ],
- [ 6, 45, "tim", "M", "GA", ],
- [ 7, 39, "keith", "M", "GA", ],
-];
-
my ($row, $nrows);
#####################################################################
@@ -159,7 +124,7 @@
my $object = $objset->get_object("stephen",["first_name"]);
ok($object->{age} == 39, "got stephen object (age 39)");
- $rep->_disconnect();
+ #$rep->_disconnect();
my $hashes = [
{ person_id => 1, age => 39, name => "stephen", gender => "M", state => "GA", num_kids => 3, },
{ person_id => 2, age => 37, name => "susan", gender => "F", state => "GA", num_kids => 3, },
@@ -218,6 +183,7 @@
my $summaries = $new_object_set->get_summary([]);
is(ref($summaries), "HASH", "Got summary hash");
is($summaries->{""}{num_kids}, 12, "Got 12 total kids");
+exit;
my $ext_summary = $new_object_set->get_ext_summary([]);
is(ref($ext_summary), "HASH", "Got summary hash");
Modified: p5ee/trunk/App-Repository/t/DBI-repobjects.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjects.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjects.t Mon Nov 10 15:22:53 2008
@@ -12,16 +12,18 @@
},
);
-
use Test::More qw(no_plan);
use lib "../App-Context/lib";
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
use App::RepositoryObject;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
package App::RepositoryObject::Man;
@ISA = ("App::RepositoryObject");
@@ -63,42 +65,16 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+my $dbtype = $App::options{dbtype} || "mysql";
###########################################################################
# DATA ACCESS TESTS
@@ -182,24 +158,34 @@
{
my $obj = $rep->get_object("test_person", 1);
is($obj->{_key}, 1, "get_object() by key");
+
my $retval = $obj->delete();
ok($retval, "delete() seems to have worked");
+
my $obj2 = $rep->get_object("test_person", 1);
ok(! defined $obj2, "delete() yep, it's really gone");
+
$obj2 = $rep->new_object("test_person", $obj);
is($obj2->{first_name},$obj->{first_name}, "new.first_name seems ok");
is($obj2->{age},$obj->{age}, "new.age seems ok");
is($obj2->{_key},$obj->{_key}, "new._key seems ok");
+
my $obj3 = $rep->get_object("test_person", 1);
ok(defined $obj2, "new() it's back");
is($obj3->{first_name},$obj->{first_name}, "new.first_name seems ok");
is($obj3->{age},$obj->{age}, "new.age seems ok");
is($obj3->{_key},$obj->{_key}, "new._key seems ok");
- my $obj4 = $rep->new_object("test_person",{first_name => "christine", gender => "F"});
- is($obj4->{first_name},"christine", "new.first_name (2) seems ok");
- is($obj4->{_key},8, "new._key is ok");
- is($obj4->{person_id},8, "new.person_id is ok");
- isa_ok($obj4, "App::RepositoryObject::Woman", "by new_object(), christine");
+
+ if ($dbtype eq 'mysql') {
+ my $obj4 = $rep->new_object("test_person",{first_name => "christine", gender => "F"});
+ is($obj4->{first_name},"christine", "new.first_name (2) seems ok");
+ is($obj4->{_key},8, "new._key is ok");
+ is($obj4->{person_id},8, "new.person_id is ok");
+ isa_ok($obj4, "App::RepositoryObject::Woman", "by new_object(), christine");
+ }
+ if ($dbtype eq 'oracle') {
+ print STDERR "**************************** WE NEED TO LOOK INTO THIS - ORA-00001: unique constraint (MVHDA_DEV_NF.SYS_C0016131) violated\n";
+ }
}
{
Modified: p5ee/trunk/App-Repository/t/DBI-repobjectset.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjectset.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjectset.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -56,42 +59,14 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
- $dbh->do($ddl);
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
###########################################################################
# DATA ACCESS TESTS
Modified: p5ee/trunk/App-Repository/t/DBI-select.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-select.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-select.t Mon Nov 10 15:22:53 2008
@@ -17,11 +17,16 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person);
use strict;
+my $dbtype = $App::options{dbtype} || "mysql";
+
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
exit(0);
@@ -48,60 +53,24 @@
},
},
},
+ default_date_format => "YYYY-MM-DD",
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-
-#cheating... I know its a DBI, but I have to set up the test somehow
-my $dbh = $rep->{dbh};
-eval { $dbh->do("drop table test_person"); };
-my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
-$dbh->do($ddl);
-
-my $columns = [ "person_id", "age", "first_name", "gender", "state", "birth_dt" ];
-my $rows = [
- [ 1, 39, "stephen", "M", "GA", "1962-01-01"],
- [ 2, 37, "susan", "F", "GA", "1964-08-08"],
- [ 3, 6, "maryalice", "F", "GA", "1996-07-07"],
- [ 4, 3, "paul", "M", "GA", "1999-04-04"],
- [ 5, 1, "christine", "F", "GA", "2000-05-05"],
- [ 6, 45, "tim", "M", "GA", "1956-02-02"],
- [ 7, 39, "keith", "M", "GA", "1962-03-03"],
-];
-
-#$App::aspect = 1;
-#eval {
-# $rep->set_rows("test_person", undef, $columns, $rows);
-#};
-#ok(!$@, "set_rows() [test_person]");
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
sub check_select {
my ($sql, $expected_rows, $debug) = @_;
my ($rows, $reprows);
eval {
- $rows = $dbh->selectall_arrayref($sql);
+ $rows = $rep->_do($sql);
};
is($@,"","sql ok");
if ($debug) {
@@ -127,7 +96,7 @@
my ($rows, $reprows);
eval {
- $rows = $dbh->selectall_arrayref($sql);
+ $rows = $rep->_do($sql);
};
is($@,"","$msg - sql ok");
@@ -526,6 +495,7 @@
#is($sql, $expect_sql, "_mk_select_sql(): param.not_matches (inferred)");
#&check_select($sql,0);
+if ($dbtype eq 'mysql') {
$expect_sql = <<EOF;
select
first_name,
@@ -535,9 +505,26 @@
where age >= 37
limit 1
EOF
-$sql = $rep->_mk_select_sql("test_person",{"age.ge" => 37},["first_name","last_name","age"],{startrow => 1, endrow => 1});
-is($sql, $expect_sql, "_mk_select_sql(): cols, endrow");
-&check_select($sql,0);
+ $sql = $rep->_mk_select_sql("test_person",{"age.ge" => 37},["first_name","last_name","age"],{startrow => 1, endrow => 1});
+ is($sql, $expect_sql, "_mk_select_sql(): cols, endrow");
+ &check_select($sql,0);
+}
+
+if ($dbtype eq 'oracle') {
+$expect_sql = <<EOF;
+select
+ first_name,
+ last_name,
+ age
+from test_person
+where age >= 37
+ and rownum >= 1
+ and rownum <= 1
+EOF
+ $sql = $rep->_mk_select_sql("test_person",{"age.ge" => 37},["first_name","last_name","age"],{startrow => 1, endrow => 1});
+ is($sql, $expect_sql, "_mk_select_sql(): cols, endrow");
+ &check_select($sql,0);
+}
$expect_sql = <<EOF;
select
@@ -632,6 +619,7 @@
is($sql, $expect_sql, "_mk_select_sql(): is not null (by .not_in 'stephen,keith,NULL')");
&check_select($sql,0);
+if ($dbtype eq 'mysql') {
$expect_sql = <<'EOF';
select
first_name
@@ -647,6 +635,25 @@
},["first_name"]);
is($sql, $expect_sql, "_mk_select_sql(): param.contains (proper quoting of ' and \\' required)");
&check_select($sql,0);
+}
+
+if ($dbtype eq 'oracle') {
+$expect_sql = <<'EOF';
+select
+ first_name
+from test_person
+where first_name like '%''%'
+ and birth_dt like '%\''_'
+EOF
+#print "[$expect_sql]\n";
+$sql = $rep->_mk_select_sql("test_person",{
+ "_order" => [ "first_name.contains", "birth_dt.matches", ],
+ "first_name.contains" => "'",
+ "birth_dt.matches" => "*\\'?",
+ },["first_name"]);
+is($sql, $expect_sql, "_mk_select_sql(): param.contains (proper quoting of ' and \\' required)");
+&check_select($sql,0);
+}
exit(0);
Modified: p5ee/trunk/App-Repository/t/DBI-transaction.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-transaction.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-transaction.t Mon Nov 10 15:22:53 2008
@@ -17,9 +17,12 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
if (!$App::options{dbuser}) {
@@ -47,42 +50,15 @@
},
},
debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
-{
- #cheating... I know its a DBI, but I have to set up the test somehow
- my $dbh = $rep->{dbh};
- eval { $dbh->do("drop table test_person"); };
- my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-) type=InnoDB
-EOF
- $dbh->do($ddl);
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','FL')");
- $dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
-}
+my $dbtype = $App::options{dbtype};
###########################################################################
# DATA ACCESS TESTS
@@ -127,22 +103,27 @@
is($first_name, "susan", "after rollback: get() 2 values (checking first_name is [$first_name])");
is($age, 37, "after rollback: get() 2 values (checking age is [$age])");
-$rep->begin_work();
-is($rep->set("test_person", 1, "first_name", "steve"),1,"set() first name [steve]");
-$first_name = $rep->get("test_person", 1, "first_name");
-is($first_name, "steve", "in transaction 2: get() (checking first_name is [$first_name])");
-
-ok($rep->set("test_person", 2, ["first_name","age"], ["sue",38]), "set() 2 values");
-($first_name, $age) = $rep->get("test_person", 2, ["first_name","age"]);
-is($first_name, "sue", "in transaction 2: get() 2 values (checking first_name is [$first_name])");
-is($age, 38, "in transaction 2: get() 2 values (checking age is [$age])");
-
-$rep->_disconnect();
-$first_name = $rep->get("test_person", 1, "first_name");
-is($first_name, "stephen", "after _disconnect: get() (checking first_name is [$first_name])");
-($first_name, $age) = $rep->get("test_person", 2, ["first_name","age"]);
-is($first_name, "susan", "after _disconnect: get() 2 values (checking first_name is [$first_name])");
-is($age, 37, "after _disconnect: get() 2 values (checking age is [$age])");
+######################################################################################
+# NOTE: Oracle commits on disconnect, so this test won't work [']
+######################################################################################
+if ($dbtype eq "mysql") {
+ $rep->begin_work();
+ is($rep->set("test_person", 1, "first_name", "steve"),1,"set() first name [steve]");
+ $first_name = $rep->get("test_person", 1, "first_name");
+ is($first_name, "steve", "in transaction 2: get() (checking first_name is [$first_name])");
+
+ ok($rep->set("test_person", 2, ["first_name","age"], ["sue",38]), "set() 2 values");
+ ($first_name, $age) = $rep->get("test_person", 2, ["first_name","age"]);
+ is($first_name, "sue", "in transaction 2: get() 2 values (checking first_name is [$first_name])");
+ is($age, 38, "in transaction 2: get() 2 values (checking age is [$age])");
+
+ $rep->_disconnect();
+ $first_name = $rep->get("test_person", 1, "first_name");
+ is($first_name, "stephen", "after _disconnect: get() (checking first_name is [$first_name])");
+ ($first_name, $age) = $rep->get("test_person", 2, ["first_name","age"]);
+ is($first_name, "susan", "after _disconnect: get() 2 values (checking first_name is [$first_name])");
+ is($age, 37, "after _disconnect: get() 2 values (checking age is [$age])");
+}
$rep->begin_work();
is($rep->set("test_person", 1, "first_name", "steve"),1,"set() first name [steve]");
Modified: p5ee/trunk/App-Repository/t/DBI-update.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-update.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-update.t Mon Nov 10 15:22:53 2008
@@ -17,11 +17,16 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
use App;
use App::Repository;
+use RepositoryTestUtils qw(create_table_test_person drop_table_test_person populate_table_test_person);
use strict;
+my $dbtype = $App::options{dbtype} || "mysql";
+
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
exit(0);
@@ -46,40 +51,15 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
my $rep = $context->repository();
-#cheating... I know its a DBI, but I have to set up the test somehow
-my $dbh = $rep->{dbh};
-eval { $dbh->do("drop table test_person"); };
-my $ddl = <<EOF;
-create table test_person (
- person_id integer not null auto_increment primary key,
- first_name varchar(99) null,
- last_name varchar(99) null,
- address varchar(99) null,
- city varchar(99) null,
- state varchar(99) null,
- zip varchar(10) null,
- country char(2) null,
- home_phone varchar(99) null,
- work_phone varchar(99) null,
- email_address varchar(99) null,
- gender char(1) null,
- birth_dt date null,
- age integer null,
- index person_ie1 (last_name, first_name)
-)
-EOF
-$dbh->do($ddl);
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
-$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
+&drop_table_test_person($rep);
+&create_table_test_person($rep);
+&populate_table_test_person($rep);
my $columns = [ "person_id", "age", "first_name", "gender", "state", "birth_dt" ];
@@ -88,7 +68,7 @@
my ($nrows);
eval {
- $nrows = $dbh->do($sql);
+ $nrows = $rep->_do($sql);
};
is($@,"","sql ok");
@@ -138,11 +118,22 @@
is($sql, $expect_sql, "_mk_update_sql(): 2 cols, by key, row is a hashref");
&check_exec($sql,1);
-$expect_sql = <<'EOF';
+if ($dbtype eq 'mysql') {
+ $expect_sql = <<'EOF';
update test_person set
first_name = '%@$\\\''
where person_id = 4
EOF
+}
+
+if ($dbtype eq 'oracle') {
+ $expect_sql = <<'EOF';
+update test_person set
+ first_name = '%@$\'''
+where person_id = 4
+EOF
+}
+
$sql = $rep->_mk_update_sql("test_person",4,["first_name"],['%@$\\\'']);
is($sql, $expect_sql, "_mk_update_sql(): proper quoting for \\'");
&check_exec($sql,1);
Modified: p5ee/trunk/App-Repository/t/SharedDatastore.t
==============================================================================
--- p5ee/trunk/App-Repository/t/SharedDatastore.t (original)
+++ p5ee/trunk/App-Repository/t/SharedDatastore.t Mon Nov 10 15:22:53 2008
@@ -19,6 +19,8 @@
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
+use lib ".";
+use lib "t";
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
@@ -28,6 +30,7 @@
BEGIN {
use_ok("App");
}
+use RepositoryTestUtils qw(create_table_test_app_cache drop_table_test_app_cache);
my $context = App->context(
%App::options,
@@ -59,7 +62,7 @@
class => "App::SharedDatastore::Repository",
compress => 1,
repository => "default",
- table => "app_cache",
+ table => "test_app_cache",
cache_type => "dbquery",
cache_type_column => "cache_type",
cache_key_column => "cache_key",
@@ -70,11 +73,15 @@
},
},
},
+ debug_sql => $App::options{debug_sql},
+ trace => $App::options{trace},
);
-{
- &initialize_tests();
+my $rep = $context->repository();
+&drop_table_test_app_cache($rep);
+&create_table_test_app_cache($rep);
+{
my ($sds, $key, $value, $keyref, $valueref, $valueref2, $hashkey, $serialized_value);
foreach my $name ("default") {
@@ -86,7 +93,6 @@
my $dump = $sds->dump();
ok($dump =~ /^\$SharedDatastore__$name = /, "[$name] dump");
-
$sds->set("pi", 3.1416);
$value = $sds->get("pi");
is($value, 3.1416, "[$name] set()/get() works (for pi=$value)");
@@ -107,48 +113,31 @@
$sds->set_ref($keyref, $valueref);
$valueref2 = $sds->get_ref($keyref);
is_deeply($valueref, $valueref2, "[$name] set_ref()/get_ref() works");
-
+
$hashkey = $sds->hashkey($keyref);
$valueref2 = $sds->get_ref($hashkey);
is_deeply($valueref, $valueref2, "[$name] set_ref()/get_ref(hashkey) works (hashkey=$hashkey)");
-
+
$serialized_value = $sds->serialize($valueref);
$value = $sds->get($hashkey);
is($value, $serialized_value, "[$name] set_ref()/get(hashkey) works");
-
+
$valueref2 = $sds->deserialize($serialized_value);
is_deeply($valueref, $valueref2, "[$name] serialize()/deserialize() works");
-
+
$value = $sds->get("foo");
is($value, undef, "[$name] get(foo) is undef");
-
+
$valueref2 = $sds->get_ref("foo");
is($valueref2, undef, "[$name] get_ref(foo) is undef");
-
+
$sds->set_ref("foo", undef);
$value = $sds->get_ref("foo");
is($value, undef, "[$name] get_ref(foo) is undef after set to undef");
}
}
-sub initialize_tests {
- my $rep = $context->repository("default");
- $rep->_do("drop table if exists app_cache");
- my $ddl = <<EOF;
-CREATE TABLE app_cache (
- cache_type varchar(16) NOT NULL,
- cache_key varchar(40) NOT NULL,
- generate_dttm datetime default NULL,
- serializer varchar(12) default NULL,
- serialization_args varchar(64) default NULL,
- data longblob,
- modify_dttm timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
- PRIMARY KEY (cache_type,cache_key),
- KEY app_cache_ie1 (modify_dttm)
-) ENGINE=InnoDB DEFAULT CHARSET=latin1
-EOF
- $rep->_do($ddl);
-}
+&drop_table_test_app_cache($rep);
exit 0;