[Rt-commit] [svn] r1323 - in
DBIx-SearchBuilder/branches/1.20-SYBASE: . SearchBuilder
SearchBuilder/Handle SearchBuilder/Record
jesse at pallas.eruditorum.org
jesse at pallas.eruditorum.org
Sun Aug 8 16:10:37 EDT 2004
Author: jesse
Date: Sun Aug 8 16:10:36 2004
New Revision: 1323
Modified:
DBIx-SearchBuilder/branches/1.20-SYBASE/ (props changed)
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm
DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm
Log:
----------------------------------------------------------------------
r8357 at tinbook: jesse | 2004-08-07T21:52:23.051740Z
----------------------------------------------------------------------
r8369 at tinbook: jesse | 2004-08-08T19:59:34.473965Z
----------------------------------------------------------------------
r8368 at tinbook: jesse | 2004-08-08T19:59:07.424693Z
Sybase work
----------------------------------------------------------------------
----------------------------------------------------------------------
r8371 at tinbook: jesse | 2004-08-08T20:10:54.540730Z
----------------------------------------------------------------------
r8370 at tinbook: jesse | 2004-08-08T20:09:55.240172Z
----------------------------------------------------------------------
----------------------------------------------------------------------
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder.pm Sun Aug 8 16:10:36 2004
@@ -44,8 +44,10 @@
sub _Init {
my $self = shift;
- my %args = ( Handle => undef,
- @_ );
+ my %args = (
+ Handle => undef,
+ @_
+ );
$self->{'DBIxHandle'} = $args{'Handle'};
$self->CleanSlate();
@@ -121,16 +123,16 @@
if ( $self->_isLimited > 0 );
# DISTINCT query only required for multi-table selects
- if ($self->_isJoined) {
- $self->_DistinctQuery(\$QueryString, $self->{'table'});
- } else {
+ if ( $self->_isJoined ) {
+ $self->_DistinctQuery( \$QueryString, $self->{'table'} );
+ }
+ else {
$QueryString = "SELECT main.* FROM $QueryString";
}
$QueryString .= $self->_OrderClause;
- $self->_ApplyLimits(\$QueryString);
-
+ $self->_ApplyLimits( \$QueryString );
print STDERR "DBIx::SearchBuilder->DoSearch Query: $QueryString\n"
if ( $self->DEBUG );
@@ -147,7 +149,8 @@
return (undef);
}
eval {
- if ( !$self->{'records'}->execute ) {
+ if ( !$self->{'records'}->execute )
+ {
warn "DBIx::SearchBuilder error:"
. $self->{'records'}->errstr
. "\n\tQuery String is $QueryString\n";
@@ -210,20 +213,17 @@
$QueryString .= $self->_WhereClause . " "
if ( $self->_isLimited > 0 );
-
-
# DISTINCT query only required for multi-table selects
- if ($self->_isJoined) {
- $QueryString = $self->_Handle->DistinctCount(\$QueryString);
- } else {
+ if ( $self->_isJoined ) {
+ $QueryString = $self->_Handle->DistinctCount( \$QueryString );
+ }
+ else {
$QueryString = "SELECT count(main.id) FROM " . $QueryString;
}
print STDERR "DBIx::SearchBuilder->DoSearch Query: $QueryString\n"
if ( $self->DEBUG );
-
-
# {{{ get count out of the database
eval { $self->{'records'} = $self->_Handle->dbh->prepare($QueryString); };
if ($@) {
@@ -236,7 +236,8 @@
return (undef);
}
eval {
- if ( !$self->{'records'}->execute ) {
+ if ( !$self->{'records'}->execute )
+ {
warn "DBIx::SearchBuilder error:"
. $self->{'records'}->errstr
. "\n\tQuery String is $QueryString\n";
@@ -251,17 +252,16 @@
# }}}
my @row = $self->{'records'}->fetchrow_array();
- $self->{$all?'count_all':'raw_rows'} = $row[0];
+ $self->{ $all ? 'count_all' : 'raw_rows' } = $row[0];
$self->{records}->finish;
delete $self->{records};
- return ( $row[0] )
+ return ( $row[0] );
}
# }}}
-
=head2 _ApplyLimits STATEMENTREF
This routine takes a reference to a scalar containing an SQL statement.
@@ -271,17 +271,18 @@
=cut
-
sub _ApplyLimits {
my $self = shift;
my $statementref = shift;
- $self->_Handle->ApplyLimits($statementref, $self->RowsPerPage, $self->FirstRow);
+ $self->_Handle->ApplyLimits( $statementref, $self->RowsPerPage,
+ $self->FirstRow );
$$statementref =~ s/main\.\*/join(', ', @{$self->{columns}})/eg
- if $self->{columns} and @{$self->{columns}};
- if (my $groupby = $self->_GroupClause) {
- $$statementref =~ s/(LIMIT \d+)?$/$groupby $1/;
+ if $self->{columns}
+ and @{ $self->{columns} };
+ if ( my $groupby = $self->_GroupClause ) {
+ $$statementref =~ s/(LIMIT \d+)?$/$groupby $1/;
}
-
+
}
# {{{ sub _DistinctQuery
@@ -300,12 +301,12 @@
my $table = shift;
# XXX - Postgres gets unhappy with distinct and OrderBy aliases
- if ($self->{order_clause} =~ /(?<!main)\./) {
- $self->DEBUG(1);
+ if ( $self->{order_clause} =~ /(?<!main)\./ ) {
+ $self->DEBUG(1);
$$statementref = "SELECT main.* FROM $$statementref";
}
else {
- $self->_Handle->DistinctQuery($statementref, $table)
+ $self->_Handle->DistinctQuery( $statementref, $table );
}
}
@@ -319,7 +320,6 @@
=cut
-
sub _BuildJoins {
my $self = shift;
@@ -338,23 +338,21 @@
sub _isJoined {
my $self = shift;
- if (keys(%{$self->{'left_joins'}})) {
- return(1);
- } else {
- return(@{$self->{'aliases'}});
+ if ( keys( %{ $self->{'left_joins'} } ) ) {
+ return (1);
+ }
+ else {
+ return ( @{ $self->{'aliases'} } );
}
}
# }}}
-
# {{{ sub _LimitClause
# LIMIT clauses are used for restricting ourselves to subsets of the search.
-
-
sub _LimitClause {
my $self = shift;
my $limit_clause;
@@ -642,31 +640,21 @@
my $tmp = $self->_Handle->dbh->quote( $args{'VALUE'} );
# Accomodate DBI drivers that don't understand UTF8
- if ($] >= 5.007) {
- require Encode;
- if( Encode::is_utf8( $args{'VALUE'} ) ) {
- Encode::_utf8_on( $tmp );
- }
+ if ( $] >= 5.007 ) {
+ require Encode;
+ Encode::_utf8_on($tmp) if Encode::is_utf8( $args{'VALUE'} );
+
}
- $args{'VALUE'} = $tmp;
+ $args{'VALUE'} = $tmp;
}
}
$Alias = $self->_GenericRestriction(%args);
- warn "No table alias set!"
- unless $Alias;
-
# We're now limited. people can do searches.
-
$self->_isLimited(1);
- if ( defined($Alias) ) {
return ($Alias);
- }
- else {
- return (1);
- }
}
# }}}
@@ -713,7 +701,8 @@
sub _GenericRestriction {
my $self = shift;
- my %args = ( TABLE => $self->{'table'},
+ my %args = (
+ TABLE => $self->{'table'},
FIELD => undef,
VALUE => undef,
ALIAS => undef,
@@ -723,62 +712,38 @@
SUBCLAUSE => undef,
CASESENSITIVE => undef,
QUOTEVALUE => undef,
- @_ );
-
- my ( $Clause, $QualifiedField );
-
- #TODO: $args{'VALUE'} should take an array of values and generate
- # the proper where clause.
+ @_
+ );
#If we're performing a left join, we really want the alias to be the
#left join criterion.
if ( ( defined $args{'LEFTJOIN'} )
- && ( !defined $args{'ALIAS'} ) ) {
+ && ( !defined $args{'ALIAS'} ) )
+ {
$args{'ALIAS'} = $args{'LEFTJOIN'};
}
- # {{{ if there's no alias set, we need to set it
-
unless ( $args{'ALIAS'} ) {
#if the table we're looking at is the same as the main table
+ # this code assumes no self joins on that table.
if ( $args{'TABLE'} eq $self->{'table'} ) {
-
- # TODO this code assumes no self joins on that table.
- # if someone can name a case where we'd want to do that,
- # I'll change it.
-
$args{'ALIAS'} = 'main';
}
-
- # {{{ if we're joining, we need to work out the table alias
-
else {
$args{'ALIAS'} = $self->NewAlias( $args{'TABLE'} );
}
- # }}}
}
- # }}}
-
- # Set this to the name of the field and the alias, unless we've been
- # handed a subclause name
-
- $QualifiedField = $args{'ALIAS'} . "." . $args{'FIELD'};
+ my $QualifiedField = $args{'ALIAS'} . "." . $args{'FIELD'};
- if ( $args{'SUBCLAUSE'} ) {
- $Clause = $args{'SUBCLAUSE'};
- }
- else {
- $Clause = $QualifiedField;
- }
+ # If we've been handed a subclause, we want to use that,
+ # otherwise, we put together one subclause per ALIAS/FIELD combo
+ my $Clause = ( $args{'SUBCLAUSE'} || $QualifiedField );
- print STDERR "$self->_GenericRestriction QualifiedField=$QualifiedField\n"
- if ( $self->DEBUG );
-
- my ($restriction);
+ my $restriction;
# If we're trying to get a leftjoin restriction, lets set
# $restriction to point htere. otherwise, lets construct normally
@@ -793,7 +758,12 @@
# If it's a new value or we're overwriting this sort of restriction,
- if ( $self->_Handle->CaseSensitive && defined $args{'VALUE'} && $args{'VALUE'} ne '' && $args{'VALUE'} ne "''" && ($args{'OPERATOR'} !~/IS/ && $args{'VALUE'} !~ /^null$/i)) {
+ if ( $self->_Handle->CaseSensitive
+ && defined $args{'VALUE'}
+ && $args{'VALUE'} ne ''
+ && $args{'VALUE'} ne "''"
+ && ( $args{'OPERATOR'} !~ /IS/ && $args{'VALUE'} !~ /^null$/i ) )
+ {
unless ( $args{'CASESENSITIVE'} || !$args{'QUOTEVALUE'} ) {
( $QualifiedField, $args{'OPERATOR'}, $args{'VALUE'} ) =
@@ -812,13 +782,15 @@
delete $self->{_open_parens}{$Clause};
}
- if ( ( ( exists $args{'ENTRYAGGREGATOR'} )
- and ( $args{'ENTRYAGGREGATOR'} || "" ) eq 'none' )
- or ( !$$restriction )
- ) {
-
+ if (
+ (
+ defined $args{'ENTRYAGGREGATOR'}
+ && $args{'ENTRYAGGREGATOR'} eq 'none'
+ )
+ || !$$restriction
+ )
+ {
$$restriction = $prefix . $clause;
-
}
else {
$$restriction .= $args{'ENTRYAGGREGATOR'} . $prefix . $clause;
@@ -868,14 +840,15 @@
my $self = shift;
my ( $subclause, $where_clause );
- #Go through all the generic restrictions and build up the "generic_restrictions" subclause
- # That's the only one that SearchBuilder builds itself.
- # Arguably, the abstraction should be better, but I don't really see where to put it.
+#Go through all the generic restrictions and build up the "generic_restrictions" subclause
+# That's the only one that SearchBuilder builds itself.
+# Arguably, the abstraction should be better, but I don't really see where to put it.
$self->_CompileGenericRestrictions();
#Go through all restriction types. Build the where clause from the
#Various subclauses.
foreach $subclause ( keys %{ $self->{'subclauses'} } ) {
+
# Now, build up the where clause
if ( defined($where_clause) ) {
$where_clause .= " AND ";
@@ -936,7 +909,7 @@
sub OrderBy {
my $self = shift;
- my %args = ( @_ );
+ my %args = (@_);
$self->OrderByCols( \%args );
}
@@ -954,31 +927,34 @@
my $row;
my $clause;
- foreach $row ( @args ) {
+ foreach $row (@args) {
- my %rowhash = ( ALIAS => 'main',
- FIELD => undef,
- ORDER => 'ASC',
- %$row
- );
- if ($rowhash{'ORDER'} =~ /^des/i) {
- $rowhash{'ORDER'} = "DESC";
+ my %rowhash = (
+ ALIAS => 'main',
+ FIELD => undef,
+ ORDER => 'ASC',
+ %$row
+ );
+ if ( $rowhash{'ORDER'} =~ /^des/i ) {
+ $rowhash{'ORDER'} = "DESC";
}
else {
- $rowhash{'ORDER'} = "ASC";
+ $rowhash{'ORDER'} = "ASC";
}
- if ( ($rowhash{'ALIAS'}) and
- ($rowhash{'FIELD'}) and
- ($rowhash{'ORDER'}) ) {
-
- if ($rowhash{'FIELD'} =~ /^(\w+\()(.*\))$/) {
- # handle 'FUNCTION(FIELD)' formatted fields
- $rowhash{'ALIAS'} = $1 . $rowhash{'ALIAS'};
- $rowhash{'FIELD'} = $2;
- }
+ if ( ( $rowhash{'ALIAS'} )
+ and ( $rowhash{'FIELD'} )
+ and ( $rowhash{'ORDER'} ) )
+ {
+
+ if ( $rowhash{'FIELD'} =~ /^(\w+\()(.*\))$/ ) {
+
+ # handle 'FUNCTION(FIELD)' formatted fields
+ $rowhash{'ALIAS'} = $1 . $rowhash{'ALIAS'};
+ $rowhash{'FIELD'} = $2;
+ }
- $clause .= ($clause ? ", " : " ");
+ $clause .= ( $clause ? ", " : " " );
$clause .= $rowhash{'ALIAS'} . ".";
$clause .= $rowhash{'FIELD'} . " ";
$clause .= $rowhash{'ORDER'};
@@ -986,15 +962,15 @@
}
if ($clause) {
- $self->{'order_clause'} = "ORDER BY" . $clause;
+ $self->{'order_clause'} = "ORDER BY" . $clause;
}
else {
- $self->{'order_clause'} = "";
+ $self->{'order_clause'} = "";
}
$self->RedoSearch();
}
-# }}}
+# }}}
# {{{ sub _OrderClause
@@ -1008,9 +984,9 @@
my $self = shift;
unless ( defined $self->{'order_clause'} ) {
- return "";
+ return "";
}
- return ($self->{'order_clause'});
+ return ( $self->{'order_clause'} );
}
# }}}
@@ -1037,7 +1013,7 @@
my $subclause = "$table $alias";
- push ( @{ $self->{'aliases'} }, $subclause );
+ push( @{ $self->{'aliases'} }, $subclause );
return $alias;
}
@@ -1150,7 +1126,8 @@
if ( $self->RowsPerPage ) {
$self->FirstRow( 1 + ( $self->RowsPerPage * $page ) );
- } else {
+ }
+ else {
$self->FirstRow(1);
}
}
@@ -1231,14 +1208,11 @@
=cut
-
-
sub Count {
my $self = shift;
- # An unlimited search returns no tickets
- return 0 unless ($self->_isLimited);
-
+ # An unlimited search returns no tickets
+ return 0 unless ( $self->_isLimited );
# If we haven't actually got all objects loaded in memory, we
# really just want to do a quick count from the database.
@@ -1272,12 +1246,13 @@
sub CountAll {
my $self = shift;
- # An unlimited search returns no tickets
- return 0 unless ($self->_isLimited);
+ # An unlimited search returns no tickets
+ return 0 unless ( $self->_isLimited );
# If we haven't actually got all objects loaded in memory, we
# really just want to do a quick count from the database.
- if ( $self->{'must_redo_search'} || !$self->{'count_all'}) {
+ if ( $self->{'must_redo_search'} || !$self->{'count_all'} ) {
+
# If we haven't already asked the database for the row count, do that
$self->_DoCount(1) unless ( $self->{'count_all'} );
@@ -1294,7 +1269,6 @@
# }}}
-
# {{{ sub IsLast
=head2 IsLast
@@ -1328,36 +1302,38 @@
# }}}
-
-
-
# }}}
sub Column {
- my ($self, %args) = @_;
- my $table = $args{TABLE} || do {
- if ( my $alias = $args{ALIAS} ) {
- $alias =~ s/_\d+$//;
- $alias;
- }
- else {
- $self->{table};
- }
- };
+ my ( $self, %args ) = @_;
+ my $table;
- my $name = ($args{ALIAS} || 'main') . '.' . $args{FIELD};
- if (my $func = $args{FUNCTION}) {
- if ($func =~ /^DISTINCT\s*COUNT$/i) {
- $name = "COUNT(DISTINCT $name)";
- }
- else {
- $name = "\U$func\E($name)";
- }
+ if ( $args{TABLE} ) {
+ $table = $args{TABLE};
}
+ elsif ( $args{ALIAS} =~ /^(.*?)_\d+$/ ) {
- my $column = "col" . @{$self->{columns}||=[]};
+ # this code relies on the fact that RT generates table aliases
+ # of the form TableName_Number to create table aliases.
+ $table = $1;
+ }
+ else {
+ $table = $self->{table};
+ }
+
+ my $name = ( $args{ALIAS} || 'main' ) . '.' . $args{FIELD};
+ if ( my $func = $args{FUNCTION} ) {
+ if ( $func =~ /^DISTINCT\s*COUNT$/i ) {
+ $name = "COUNT(DISTINCT $name)";
+ }
+ else {
+ $name = "\U$func\E($name)";
+ }
+ }
+
+ my $column = "col" . @{ $self->{columns} ||= [] };
$column = $args{FIELD} if $table eq $self->{table} and !$args{ALIAS};
- push @{$self->{columns}}, "$name AS \L$column";
+ push @{ $self->{columns} }, "$name AS \L$column";
return $column;
}
@@ -1367,19 +1343,21 @@
}
sub Fields {
- my ($self, $table) = @_;
+ my ( $self, $table ) = @_;
my $dbh = $self->_Handle->dbh;
- return map lc($_->[0]), @{
- eval { $dbh->column_info('', '', $table, '')->fetchall_arrayref([3]) }
- || $dbh->selectall_arrayref("DESCRIBE $table;")
- || $dbh->selectall_arrayref("DESCRIBE \u$table;")
- || []
+ return map lc( $_->[0] ), @{
+ eval {
+ $dbh->column_info( '', '', $table, '' )->fetchall_arrayref( [3] );
+ }
+ || $dbh->selectall_arrayref("DESCRIBE $table;")
+ || $dbh->selectall_arrayref("DESCRIBE \u$table;")
+ || []
};
}
sub HasField {
- my ($self, %args) = @_;
+ my ( $self, %args ) = @_;
my $table = $args{TABLE} or die;
my $field = $args{FIELD} or die;
return grep { $_ eq $field } $self->Fields($table);
@@ -1395,7 +1373,7 @@
sub GroupBy {
my $self = shift;
- my %args = ( @_ );
+ my %args = (@_);
$self->GroupByCols( \%args );
}
@@ -1405,26 +1383,28 @@
my $row;
my $clause;
- foreach $row ( @args ) {
- my %rowhash = ( ALIAS => 'main',
- FIELD => undef,
- %$row
- );
+ foreach $row (@args) {
+ my %rowhash = (
+ ALIAS => 'main',
+ FIELD => undef,
+ %$row
+ );
+
+ if ( ( $rowhash{'ALIAS'} )
+ and ( $rowhash{'FIELD'} ) )
+ {
- if ( ($rowhash{'ALIAS'}) and
- ($rowhash{'FIELD'}) ) {
-
- $clause .= ($clause ? ", " : " ");
+ $clause .= ( $clause ? ", " : " " );
$clause .= $rowhash{'ALIAS'} . ".";
$clause .= $rowhash{'FIELD'};
}
}
if ($clause) {
- $self->{'group_clause'} = "GROUP BY" . $clause;
+ $self->{'group_clause'} = "GROUP BY" . $clause;
}
else {
- $self->{'group_clause'} = "";
+ $self->{'group_clause'} = "";
}
$self->RedoSearch();
}
@@ -1433,12 +1413,11 @@
my $self = shift;
unless ( defined $self->{'group_clause'} ) {
- return "";
+ return "";
}
- return ($self->{'group_clause'});
+ return ( $self->{'group_clause'} );
}
-
1;
__END__
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle.pm Sun Aug 8 16:10:36 2004
@@ -76,14 +76,14 @@
# my %seen; #only the *first* value is used - allows drivers to specify default
while ( my $key = shift @pairs ) {
my $value = shift @pairs;
+ #$value = $self->dbh->quote($value) unless ( $value =~ /^\d+$/);
# next if $seen{$key}++;
push @cols, $key;
push @vals, '?';
- push @bind, $value;
+ push @bind, $value;
}
- my $QueryString =
- "INSERT INTO $table (". join(", ", @cols). ") VALUES ".
+ my $QueryString = "INSERT INTO $table (". join(", ", @cols). ") VALUES ".
"(". join(", ", @vals). ")";
my $sth = $self->SimpleQuery($QueryString, @bind);
@@ -151,7 +151,7 @@
Takes a bunch of parameters:
Required: Driver, Database,
-Optional: Host, Port and RequireSSL
+Optional: Server Host, Port and RequireSSL
Builds a DSN suitable for a DBI connection
@@ -159,22 +159,29 @@
sub BuildDSN {
my $self = shift;
- my %args = ( Driver => undef,
- Database => undef,
- Host => undef,
- Port => undef,
- SID => undef,
- RequireSSL => undef,
- @_);
-
-
- my $dsn = "dbi:$args{'Driver'}:dbname=$args{'Database'}";
- $dsn .= ";sid=$args{'SID'}" if ( defined $args{'SID'} && $args{'SID'});
- $dsn .= ";host=$args{'Host'}" if (defined$args{'Host'} && $args{'Host'});
- $dsn .= ";port=$args{'Port'}" if (defined $args{'Port'} && $args{'Port'});
- $dsn .= ";requiressl=1" if (defined $args{'RequireSSL'} && $args{'RequireSSL'});
+ my %args = (
+ Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ SID => undef,
+ Server => undef,
+ RequireSSL => undef,
+ @_
+ );
+
+ my $dsn = "dbi:$args{'Driver'}:";
+ $dsn .= "dbname=$args{'Database'};"
+ if ( defined $args{'Database'} && $args{'Database'} );
+ $dsn .= "sid=$args{'SID'};" if ( defined $args{'SID'} && $args{'SID'} );
+ $dsn .= "host=$args{'Host'};" if ( defined $args{'Host'} && $args{'Host'} );
+ $dsn .= "port=$args{'Port'};" if ( defined $args{'Port'} && $args{'Port'} );
+ $dsn .= "requiressl=1;"
+ if ( defined $args{'RequireSSL'} && $args{'RequireSSL'} );
+ $dsn .= "server=$args{'Server'};"
+ if ( defined $args{'Server'} && $args{'Server'} );
- $self->{'dsn'}= $dsn;
+ $self->{'dsn'} = $dsn;
}
# }}}
@@ -308,38 +315,37 @@
=cut
-## Please see file perltidy.ERR
sub UpdateRecordValue {
my $self = shift;
- my %args = ( Table => undef,
- Column => undef,
- IsSQLFunction => undef,
- PrimaryKeys => undef,
- @_ );
+ my %args = (
+ Table => undef,
+ Column => undef,
+ IsSQLFunction => undef,
+ PrimaryKeys => undef,
+ @_
+ );
my @bind = ();
- my $query = 'UPDATE ' . $args{'Table'} . ' ';
- $query .= 'SET ' . $args{'Column'} . '=';
+ my $query = 'UPDATE ' . $args{'Table'} . ' SET ' . $args{'Column'} . ' = ';
- ## Look and see if the field is being updated via a SQL function.
- if ($args{'IsSQLFunction'}) {
- $query .= $args{'Value'} . ' ';
- }
- else {
- $query .= '? ';
- push (@bind, $args{'Value'});
- }
+ ## Look and see if the field is being updated via a SQL function.
+ if ( $args{'IsSQLFunction'} ) {
+ $query .= $args{'Value'} . ' ';
+ }
+ else {
+ $query .= " ? " ;
+ push @bind, $args{'Value'};
+ }
- ## Constructs the where clause.
- my $where = 'WHERE ';
- foreach my $key (keys %{$args{'PrimaryKeys'}}) {
- $where .= $key . "=?" . " AND ";
- push (@bind, $args{'PrimaryKeys'}{$key});
- }
- $where =~ s/AND\s$//;
-
- my $query_str = $query . $where;
- return ($self->SimpleQuery($query_str, @bind));
+ ## Constructs the where clause.
+ my @cols;
+ foreach my $key ( keys %{ $args{'PrimaryKeys'} } ) {
+ push @cols, "$key = ? ";
+ push @bind, { value => $args{PrimaryKeys}{$key}, is_numeric => 1 };
+ }
+
+ $query .= "WHERE " . join( ' AND ', @cols );
+ return ( $self->SimpleQuery( $query, @bind ) );
}
@@ -375,63 +381,100 @@
=cut
-sub SimpleQuery {
- my $self = shift;
+sub SimpleQuery {
+ my $self = shift;
my $QueryString = shift;
my @bind_values = (@_);
+ ($QueryString, @bind_values) = $self->EmulatePlaceholders($QueryString, @bind_values) if ($QueryString =~ /^\s*(?:INSERT|UPDATE)/i);
+ use Data::Dumper;
my $sth = $self->dbh->prepare($QueryString);
unless ($sth) {
- if ($DEBUG) {
- die "$self couldn't prepare the query '$QueryString'" .
- $self->dbh->errstr . "\n";
- }
- else {
- warn "$self couldn't prepare the query '$QueryString'" .
- $self->dbh->errstr . "\n";
- my $ret = Class::ReturnValue->new();
- $ret->as_error( errno => '-1',
- message => "Couldn't prepare the query '$QueryString'.". $self->dbh->errstr,
- do_backtrace => undef);
- return ($ret->return_value);
- }
- }
-
- # Check @bind_values for HASH refs
- for (my $bind_idx = 0; $bind_idx < scalar @bind_values; $bind_idx++) {
- if (ref($bind_values[$bind_idx]) eq "HASH") {
+ Carp::cluck;
+ warn "$self couldn't prepare the query '$QueryString'"
+ . $self->dbh->errstr . "\n";
+ my $rv = Class::ReturnValue->new();
+ $rv->as_error(
+ errno => '-1',
+ message => "Couldn't prepare the query '$QueryString'."
+ . $self->dbh->errstr,
+ do_backtrace => undef
+ );
+ return $rv->return_value;
+ }
+
+
+ # Check @bind_values for HASH refs
+ for ( my $bind_idx = 0 ; $bind_idx < scalar @bind_values ; $bind_idx++ ) {
+ if ( ref( $bind_values[$bind_idx] ) eq "HASH" ) {
my $bhash = $bind_values[$bind_idx];
$bind_values[$bind_idx] = $bhash->{'value'};
delete $bhash->{'value'};
- $sth->bind_param($bind_idx+1, undef, $bhash );
+ if ($bhash->{sql_type}) {
+ $sth->bind_param( $bind_idx + 1, undef, $bhash->{sql_type} );
+ } else {
+ $sth->bind_param( $bind_idx + 1, undef, $bhash );
+
+ }
}
}
- $self->Log($QueryString. " (".join(',', at bind_values).")") if ($DEBUG);
unless ( $sth->execute(@bind_values) ) {
- if ($DEBUG) {
- die "$self couldn't execute the query '$QueryString'"
- . $self->dbh->errstr . "\n";
+ Carp::cluck("Failed on $QueryString");
+ warn "$self couldn't execute the query '$QueryString'";
+
+ my $rv = Class::ReturnValue->new();
+ $rv->as_error(
+ errno => '-1',
+ message => "Couldn't execute the query '$QueryString'"
+ . $self->dbh->errstr,
+ do_backtrace => undef
+ );
+ return $rv->return_value;
+ }
+
+ return ($sth);
+
+}
+
+# }}}
+sub EmulatePlaceholders {
+ use Data::Dumper;
+ my $self = shift;
+ my $QueryString = shift;
+ my @bind_values = (@_);
+
+
+ # Replace, starting from the back of the string, so we don't
+ # confuse some chunk of a value with a placeholder
+ my $new_query = "";
+ my @query_chunks = split( /\s*\?\s*/, $QueryString );
+ foreach my $chunk ( @query_chunks ) {
+ my $value;
+ $new_query .= $chunk;
+ if (exists $bind_values[0]) {
+ my $bind_value = shift @bind_values;
+ if (ref $bind_value && $bind_value->{is_numeric}) {
+ $value = $bind_value->{value};
+ }
+ elsif (ref $bind_value && $bind_value->{is_blob}) {
+ # Sybase tries to quote blobs with 0x, which doesn't work so
+ # well for inline blobs ;)
+ $value = $self->dbh->quote($bind_value->{'value'});
+ }
+ elsif ( ref $bind_value) {
+ $value = $self->dbh->quote( $bind_value->{value},
+ $bind_value->{sql_type} );
}
else {
- warn "$self couldn't execute the query '$QueryString'";
-
- my $ret = Class::ReturnValue->new();
- $ret->as_error(
- errno => '-1',
- message => "Couldn't execute the query '$QueryString'"
- . $self->dbh->errstr,
- do_backtrace => undef );
- return ($ret->return_value);
+ $value = $self->dbh->quote($bind_value);
}
-
+ $new_query .= " $value ";
}
- return ($sth);
-
-
- }
+ }
+ return ($new_query);
-# }}}
+}
# {{{ sub FetchResult
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Oracle.pm Sun Aug 8 16:10:36 2004
@@ -1,12 +1,11 @@
-# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Oracle.pm,v 1.14 2002/01/28 06:11:37 jesse Exp $
+use strict;
package DBIx::SearchBuilder::Handle::Oracle;
use DBIx::SearchBuilder::Handle;
- at ISA = qw(DBIx::SearchBuilder::Handle);
+use base qw(DBIx::SearchBuilder::Handle);
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use vars qw($VERSION $DBIHandle $DEBUG);
-use strict;
=head1 NAME
@@ -28,14 +27,6 @@
=cut
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
- return ($self);
-}
-
# {{{ sub Connect
@@ -65,7 +56,7 @@
$self->SimpleQuery("ALTER SESSION set NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'");
- return ($DBIHandle);
+ return ($self->dbh);
}
# }}}
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Handle/Sybase.pm Sun Aug 8 16:10:36 2004
@@ -1,11 +1,10 @@
-# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Sybase.pm,v 1.8 2001/10/12 05:27:05 jesse Exp $
+use strict;
package DBIx::SearchBuilder::Handle::Sybase;
use DBIx::SearchBuilder::Handle;
- at ISA = qw(DBIx::SearchBuilder::Handle);
+use base qw(DBIx::SearchBuilder::Handle);
-use vars qw($VERSION @ISA $DBIHandle $DEBUG);
-use strict;
+use vars qw($VERSION $DEBUG);
=head1 NAME
@@ -26,6 +25,42 @@
=cut
+
+
+# {{{ sub Connect
+
+=head2 Connect PARAMHASH: Driver, Database, Host, User, Password
+
+Takes a paramhash and connects to your DBI datasource.
+
+
+=cut
+
+sub Connect {
+ my $self = shift;
+
+ my %args = ( Driver => undef,
+ Database => undef,
+ User => undef,
+ Password => undef,
+ SID => undef,
+ Host => undef,
+ @_);
+
+ $self->SUPER::Connect(%args);
+
+ # Will return dates in the format
+ # Nov 15 1998 11:30:11:496AM
+ # It'd be really nice if sybase supported ISO dates.
+ $self->dbh->func('LONG', '_date_fmt');
+
+
+
+ return ($self->dbh);
+}
+# }}}
+
+
# {{{ sub Insert
=head2 Insert
@@ -67,20 +102,7 @@
# }}}
-=head2 DatabaseVersion
-
-return the database version, trimming off any -foo identifier
-=cut
-
-sub DatabaseVersion {
- my $self = shift;
- my $v = $self->SUPER::DatabaseVersion();
-
- $v =~ s/\-(.*)$//;
- return ($v);
-
-}
=head2 CaseSensitive
@@ -106,8 +128,9 @@
}
-=head2 DistinctQuery STATEMENTREFtakes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+=head2 DistinctQuery STATEMENTREF
+takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
=cut
@@ -136,7 +159,5 @@
return(undef);
}
-# }}}
-
-# }}}
+1;
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record.pm Sun Aug 8 16:10:36 2004
@@ -579,19 +579,20 @@
*__value = \&__Value;
sub __Value {
my $self = shift;
- my $field = lc(shift);
+ my $field =shift;
- if (!$self->{'fetched'}{$field} and my $id = $self->{'values'}{'id'}) {
+ my $lc_field = lc($field);
+ if (!$self->{'fetched'}{$lc_field} and my $id = $self->{'values'}{'id'}) {
my $QueryString = "SELECT $field FROM " . $self->Table . " WHERE id = ?";
my $sth = $self->_Handle->SimpleQuery( $QueryString, $id );
my ($value) = eval { $sth->fetchrow_array() };
warn $@ if $@;
- $self->{'values'}{$field} = $value;
- $self->{'fetched'}{$field} = 1;
+ $self->{'values'}{$lc_field} = $value;
+ $self->{'fetched'}{$lc_field} = 1;
}
- return($self->{'values'}{$field});
+ return($self->{'values'}{$lc_field});
}
# }}}
# {{{ sub _Value
@@ -685,6 +686,11 @@
$args{'Table'} = $self->Table();
$args{'PrimaryKeys'} = { $self->PrimaryKeys() };
+ unless ($args{'IsSQLFunction'}) {
+ $args{'Value'} = $self->AnnotateColumnValue($args{'Column'}, $args{Value});
+
+ }
+
my $val = $self->_Handle->UpdateRecordValue(%args);
unless ($val) {
$ret->as_array( 0,
@@ -702,8 +708,12 @@
$self->Load( $self->Id );
}
else {
+ if (ref($args{'Value'})) {
+ $self->{'values'}->{"$column"} = $args{'Value'}->{'value'};
+ } else {
$self->{'values'}->{"$column"} = $args{'Value'};
}
+ }
}
$ret->as_array( 1, "The new value has been set." );
return ($ret->return_value);
@@ -857,7 +867,7 @@
my $value;
my $function = "?";
if (ref $hash{$key} eq 'HASH') {
- $op = $hash{$key}->{operator};
+ $op = ($hash{$key}->{operator} || '=');
$value = $hash{$key}->{value};
$function = $hash{$key}->{function} || "?";
} else {
@@ -1056,33 +1066,62 @@
*create = \&Create;
-sub Create {
- my $self = shift;
+sub Create {
+ my $self = shift;
my %attribs = @_;
- my ($key);
- foreach $key (keys %attribs) {
- my $method = "Validate$key";
- unless ($self->$method($attribs{$key})) {
- delete $attribs{$key};
- };
- }
- unless ($self->_Handle->KnowsBLOBs) {
- # Support for databases which don't deal with LOBs automatically
- my $ca = $self->_ClassAccessible();
- foreach $key (keys %attribs) {
- if ($ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i) {
- my $bhash = $self->_Handle->BLOBParams($key, $ca->{$key}->{'type'});
- $bhash->{'value'} = $attribs{$key};
- $attribs{$key} = $bhash;
- }
+ foreach my $key ( keys %attribs ) {
+ my $method = "Validate$key";
+ unless ( $self->$method( $attribs{$key} ) ) {
+ delete $attribs{$key};
}
}
- return ($self->_Handle->Insert($self->Table, %attribs));
- }
+
+ foreach my $key ( keys %attribs ) {
+ $attribs{$key} = $self->AnnotateColumnValue($key, $attribs{$key});
+ }
+ return ( $self->_Handle->Insert( $self->Table, %attribs ) );
+}
# }}}
+=head2 AnnotateColumnValue COLUMN VALUE
+
+Peeks inside the ClassAccessible hash to turn a $value into a hash with
+some useful data, so that the database engine doing an insert or an update
+can figure up how to deal with the datatype in question.
+
+=cut
+
+sub AnnotateColumnValue {
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+ # Support for databases which don't deal with LOBs automatically
+ my $ca = $self->_ClassAccessible();
+
+ my $bhash;
+
+
+
+ if ( !$self->_Handle->KnowsBLOBs
+ && $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i )
+ {
+ $bhash = $self->_Handle->BLOBParams( $key, $ca->{$key}->{'type'} );
+ }
+
+ if (ref $value) {
+ $bhash = $value;
+ } else {
+ $bhash->{'value'} = $value;
+ }
+ $bhash->{'type'} = $ca->{$key}->{'type'};
+ $bhash->{'is_numeric'} = $ca->{$key}->{'is_numeric'};
+ $bhash->{'is_blob'} = $ca->{$key}->{'is_blob'};
+ $bhash->{'sql_type'} = $ca->{$key}->{'sql_type'};
+ return $bhash;
+
+}
# {{{ sub Delete
*delete = \&Delete;
Modified: DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm
==============================================================================
--- DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm (original)
+++ DBIx-SearchBuilder/branches/1.20-SYBASE/SearchBuilder/Record/Cachable.pm Sun Aug 8 16:10:36 2004
@@ -259,7 +259,7 @@
$value ||= '__undef';
if ( ref($value) eq "HASH" ) {
- $value = $value->{operator}.$value->{value};
+ $value = ($value->{operator}||'=').$value->{value};
} else {
$value = "=".$value;
}
More information about the Rt-commit
mailing list