cvsuser 05/03/02 09:18:11
Modified: App-Repository/lib/App/Repository DBI.pm
Log:
recognize the following special cases in inferred-op params:
'ALL','NULL','NULL,value','@[db expr]'
Revision Changes Path
1.23 +93 -41 p5ee/App-Repository/lib/App/Repository/DBI.pm
Index: DBI.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Repository/lib/App/Repository/DBI.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- DBI.pm 20 Jan 2005 18:00:59 -0000 1.22
+++ DBI.pm 2 Mar 2005 17:18:10 -0000 1.23
@@ -1,13 +1,13 @@
######################################################################
-## File: $Id: DBI.pm,v 1.22 2005/01/20 18:00:59 spadkins Exp $
+## File: $Id: DBI.pm,v 1.23 2005/03/02 17:18:10 spadkins Exp $
######################################################################
use App;
use App::Repository;
package App::Repository::DBI;
-$VERSION = do { my @r=(q$Revision: 1.22 $=~/\d+/g); sprintf
"%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.23 $=~/\d+/g); sprintf
"%d."."%02d"x$#r,@r};
@ISA = ( "App::Repository" );
@@ -569,14 +569,17 @@
$param_order = [ (keys %$params) ];
}
if (defined $param_order && $#$param_order > -1) {
+ my ($include_null, $inferred_op, @where);
for ($colnum = 0; $colnum <= $#$param_order; $colnum++) {
$param = $param_order->[$colnum];
$column = $param;
$sqlop = "=";
$repop = "";
+ $inferred_op = 1;
# check if $column contains an embedded operation, i.e.
"name.eq", "name.contains"
if ($param =~ /^(.*)\.([^.]+)$/) {
$repop = $2;
+ $inferred_op = 0;
if ($sqlop{$repop}) {
$column = $1;
$sqlop = $sqlop{$repop};
@@ -584,7 +587,7 @@
}
if ($repop eq "verbatim") {
- $where .= ($colnum == 0) ? "where $params->{$param}\n" : "
and $params->{$param}\n";
+ push(@where, "$params->{$param}");
next;
}
@@ -603,23 +606,29 @@
}
next if (!defined $column_def); # skip if the column is unknown
+
if (! defined $params->{$param}) {
# $value = "?"; # TODO: make this work with the
"contains/matches" operators
if (!$sqlop || $sqlop eq "=") {
- $where .= ($colnum == 0) ? "where $column is null\n" : "
and $column is null\n";
+ push(@where, "$column is null");
}
else {
- $where .= ($colnum == 0) ? "where $column is not null\n"
: " and $column is not null\n";
+ push(@where, "$column is not null");
}
}
else {
$value = $params->{$param};
+ next if ($inferred_op && $value eq "ALL");
+
if (ref($value) eq "ARRAY") {
$value = join(",", @$value);
}
- if ($value =~ s/[EMAIL PROTECTED](.*)\}$/$1/) { # new @{}
expressions replace !expr!
+ if ($value =~ s/[EMAIL PROTECTED](.*)\]$/$1/) { # new @[]
expressions replace !expr!
+ $quoted = 0;
+ }
+ elsif ($value =~ s/[EMAIL PROTECTED](.*)\}$/$1/) { #
replaced !expr!, but @{x} is interp'd by perl so deprecate!
$quoted = 0;
}
elsif ($value =~ s/^!expr!//) { # deprecated (ugh!)
@@ -632,6 +641,8 @@
$quoted = (defined $column_def->{quoted}) ?
($column_def->{quoted}) : ($value !~ /^-?[0-9.]+$/);
}
+ $include_null = 0;
+
if ($repop eq "contains") {
$value =~ s/'/\\'/g;
$value = "'%$value%'";
@@ -644,25 +655,34 @@
$value = "'$value'";
}
elsif ($sqlop eq "in" || $sqlop eq "=") {
- if ($quoted) {
- $value =~ s/'/\\'/g;
- if ($value =~ /,/ && !
$tabledef->{param}{$param}{no_auto_in_param}) {
- $value =~ s/,/','/g;
- $value = "('$value')";
- $sqlop = "in";
- }
- else {
- $value = "'$value'";
- $sqlop = "=";
- }
+ if (! defined $value || $value eq "NULL") {
+ $sqlop = "is";
+ $value = "null";
}
else {
- if ($value =~ /,/ && !
$tabledef->{param}{$param}{no_auto_in_param}) {
- $value = "($value)";
- $sqlop = "in";
+ if ($value =~ s/NULL,//g || $value =~ s/,NULL//) {
+ $include_null = 1;
+ }
+ if ($quoted) {
+ $value =~ s/'/\\'/g;
+ if ($value =~ /,/ && !
$tabledef->{param}{$param}{no_auto_in_param}) {
+ $value =~ s/,/','/g;
+ $value = "('$value')";
+ $sqlop = "in";
+ }
+ else {
+ $value = "'$value'";
+ $sqlop = "=";
+ }
}
else {
- $sqlop = "=";
+ if ($value =~ /,/ && !
$tabledef->{param}{$param}{no_auto_in_param}) {
+ $value = "($value)";
+ $sqlop = "in";
+ }
+ else {
+ $sqlop = "=";
+ }
}
}
}
@@ -675,9 +695,17 @@
$column = $dbexpr;
$column =~ s/$alias.//g;
}
- $where .= ($colnum == 0) ? "where $column $sqlop $value\n" :
" and $column $sqlop $value\n";
+ if ($include_null) {
+ push(@where, "($column $sqlop $value or $column is
null)");
+ }
+ else {
+ push(@where, "$column $sqlop $value");
+ }
}
}
+ if ($#where > -1) {
+ $where = "where " . join("\n and ", @where) . "\n";
+ }
}
&App::sub_exit($where) if ($App::trace);
$where;
@@ -747,7 +775,7 @@
$cols = [$cols] if (!ref($cols));
$options = {} if (!$options);
- my ($order_by, $direction, $param_order, $col, $colnum, $dir);
+ my ($order_by, $direction, $param_order, $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
@@ -1021,6 +1049,7 @@
);
my ($where_condition, @join_conditions, @criteria_conditions, $param,
$repop, $sqlop, $paramvalue);
+ my ($include_null, $inferred_op);
for ($idx = 0; $idx <= $#$param_order; $idx++) {
$param = $param_order->[$idx];
@@ -1045,9 +1074,11 @@
$sqlop = "=";
$repop = "";
+ $inferred_op = 1;
# check if $param contains an embedded operation, i.e. "name.eq",
"name.contains"
if ($param =~ /^(.*)\.([^.]+)$/) {
$repop = $2;
+ $inferred_op = 0;
if ($sqlop{$repop}) {
$column = $1;
$sqlop = $sqlop{$repop};
@@ -1075,6 +1106,8 @@
next if (!defined $column_def); # skip if the column is unknown
+ $include_null = 0;
+
if (! defined $params->{$param}) {
# $paramvalue = "?"; # TODO: make this work with the
"contains/matches" operators
$sqlop = (!$sqlop || $sqlop eq "=") ? "is" : "is not";
@@ -1085,12 +1118,16 @@
next if (defined $table_def->{param}{$param}{all_value} &&
$paramvalue eq $table_def->{param}{$param}{all_value});
+ next if ($inferred_op && $paramvalue eq "ALL");
if (ref($paramvalue) eq "ARRAY") {
$paramvalue = join(",", @$paramvalue);
}
- if ($paramvalue =~ s/[EMAIL PROTECTED](.*)\}$/$1/) { # new @{}
expressions replace !expr!
+ if ($paramvalue =~ s/[EMAIL PROTECTED](.*)\]$/$1/) { # new @[]
expressions replace !expr!
+ $quoted = 0;
+ }
+ elsif ($paramvalue =~ s/[EMAIL PROTECTED](.*)\}$/$1/) { # new
@{} don't work.. perl interpolates... deprecate.
$quoted = 0;
}
elsif ($paramvalue =~ s/^!expr!//) { # deprecated (ugh!)
@@ -1115,25 +1152,35 @@
$paramvalue = "'$paramvalue'";
}
elsif ($sqlop eq "in" || $sqlop eq "=") {
- if ($quoted) {
- $paramvalue =~ s/'/\\'/g;
- if ($paramvalue =~ /,/ && !
$table_def->{param}{$param}{no_auto_in_param}) {
- $paramvalue =~ s/,/','/g;
- $paramvalue = "('$paramvalue')";
- $sqlop = "in";
- }
- else {
- $paramvalue = "'$paramvalue'";
- $sqlop = "=";
- }
+
+ if (! defined $paramvalue || $paramvalue eq "NULL") {
+ $sqlop = "is";
+ $paramvalue = "null";
}
else {
- if ($paramvalue =~ /,/ && !
$table_def->{param}{$param}{no_auto_in_param}) {
- $paramvalue = "($paramvalue)";
- $sqlop = "in";
+ if ($paramvalue =~ s/NULL,//g || $paramvalue =~
s/,NULL//) {
+ $include_null = 1;
+ }
+ if ($quoted) {
+ $paramvalue =~ s/'/\\'/g;
+ if ($paramvalue =~ /,/ && !
$table_def->{param}{$param}{no_auto_in_param}) {
+ $paramvalue =~ s/,/','/g;
+ $paramvalue = "('$paramvalue')";
+ $sqlop = "in";
+ }
+ else {
+ $paramvalue = "'$paramvalue'";
+ $sqlop = "=";
+ }
}
else {
- $sqlop = "=";
+ if ($paramvalue =~ /,/ && !
$table_def->{param}{$param}{no_auto_in_param}) {
+ $paramvalue = "($paramvalue)";
+ $sqlop = "in";
+ }
+ else {
+ $sqlop = "=";
+ }
}
}
}
@@ -1146,7 +1193,12 @@
$dbexpr = $column_def->{dbexpr};
if (defined $dbexpr && $dbexpr ne "") {
$self->_require_tables($dbexpr, \%reqd_tables, $tablealiashref,
2);
- push(@criteria_conditions, "$dbexpr $sqlop $paramvalue");
+ if ($include_null) {
+ push(@criteria_conditions, "($dbexpr $sqlop $paramvalue or
$dbexpr is null)");
+ }
+ else {
+ push(@criteria_conditions, "$dbexpr $sqlop $paramvalue");
+ }
}
}
@@ -1719,7 +1771,7 @@
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $paramvalues) = @_;
$self->_load_table_metadata($table) if (!defined
$self->{table}{$table}{loaded});
- my ($sql, $col, $colnum);
+ my ($sql);
$sql = "delete from $table\n";
$sql .= $self->_mk_where_clause($table, $params);
