From b4a403644cb80a612dd028882f971bdd20839275 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 23 Jun 2000 12:25:59 +0000 Subject: [PATCH] FS::Record::qsearch - more portable, doesn't depend on $sth->execute returning a number of rows, uses placeholders and prepare_cached --- CREDITS | 3 ++ FS/FS/Record.pm | 86 +++++++++++++++++++++++++++++++++++---------------------- FS/FS/UID.pm | 32 +++++++++++++-------- TODO | 8 ++---- 4 files changed, 80 insertions(+), 49 deletions(-) diff --git a/CREDITS b/CREDITS index c6063b9f2..9dbed100d 100644 --- a/CREDITS +++ b/CREDITS @@ -58,5 +58,8 @@ and probably other things too (sorry if I forgot them). Kenny Elliott contributed ICRADIUS radreply table support, allowing attributes with ICRADIUS. +Stephen Amadei contribued portability cleanups for the +low-level DBI stuff. + Everything else is my (Ivan Kohler ) fault. diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index dae9f3707..0d989e300 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,17 +1,20 @@ package FS::Record; use strict; -use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK); +use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); use File::CounterFile; -use FS::UID qw(dbh checkruid swapuid getotaker datasrc); +use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); use FS::dbdef; +use diagnostics; @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); +$DEBUG = 0; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::Record'} = sub { $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc; @@ -124,7 +127,7 @@ sub new { $hashref->{$field}='' unless defined $hashref->{$field}; #trim the '$' and ',' from money fields for Pg (belong HERE?) #(what about Pg i18n?) - if ( datasrc =~ m/Pg/ + if ( driver_name eq 'Pg' && $self->dbdef_table->column($field)->type eq 'money' ) { ${$hashref}{$field} =~ s/^\$//; ${$hashref}{$field} =~ s/\,//; @@ -157,37 +160,50 @@ objects. =cut sub qsearch { - my($table,$record) = @_; - my($dbh) = dbh; + my($table, $record) = @_; + my $dbh = dbh; + + my @fields = grep exists($record->{$_}), fields($table); + + my $statement = "SELECT * FROM $table"; + if ( @fields ) { + $statement .= " WHERE ". join(' AND ', map { + if ( $record->{$_} eq '' || $record->{$_} eq undef ) { + if ( driver_name eq 'Pg' ) { + "$_ IS NULL"; + } else { + qq-( $_ IS NULL OR $_ = "" )-; + } + } else { + "$_ = ?"; + } + } @fields ); + } - my(@fields)=grep exists($record->{$_}), fields($table); + warn $statement if $DEBUG; + my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr; - my($sth); - my($statement) = "SELECT * FROM $table". ( @fields - ? " WHERE ". join(' AND ', - map { - $record->{$_} eq '' - ? ( datasrc =~ m/Pg/ - ? "$_ IS NULL" - : "( $_ IS NULL OR $_ = \"\" )" - ) - : "$_ = ". _quote($record->{$_},$table,$_) - } @fields - ) : '' - ); - $sth=$dbh->prepare($statement) - or croak $dbh->errstr; #is that a little too harsh? hmm. - #warn $statement #if $debug # or some such; + $sth->execute( map $record->{$_}, + grep $record->{$_} ne '' && $record->{$_} ne undef, @fields + ) or croak $dbh->errstr; - if ( eval ' scalar(@FS::'. $table. '::ISA);' ) { - map { - eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );'; - } ( 1 .. $sth->execute ); + if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { + if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) { + #derivied class didn't override new method, so this optimization is safe + map { + new( "FS::$table", { %{$_} } ) + } @{$sth->fetchall_arrayref( {} )}; + } else { + warn "untested code (class FS::$table uses custom new method)"; + map { + eval 'FS::'. $table. '->new( { %{$_} } )'; + } @{$sth->fetchall_arrayref( {} )}; + } } else { - cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects"; + cluck "warning: FS::$table not loaded; returning FS::Record objects"; map { - new FS::Record ($table,$sth->fetchrow_hashref); - } ( 1 .. $sth->execute ); + FS::Record->new( $table, { %{$_} } ); + } @{$sth->fetchall_arrayref( {} )}; } } @@ -390,7 +406,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( datasrc =~ m/Pg/ + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -462,7 +478,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( datasrc =~ m/Pg/ + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -825,7 +841,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.3 2000-03-03 18:21:38 ivan Exp $ +$Id: Record.pm,v 1.4 2000-06-23 12:25:59 ivan Exp $ =head1 BUGS @@ -849,7 +865,7 @@ The ut_ methods should ask the dbdef for a default length. ut_sqltype (like ut_varchar) should all be defined -A fallback check method should be provided whith uses the dbdef. +A fallback check method should be provided which uses the dbdef. The ut_money method assumes money has two decimal digits. @@ -864,6 +880,10 @@ All the subroutines probably should be methods, here or elsewhere. Probably should borrow/use some dbdef methods where appropriate (like sub fields) +As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc, +or allow it to be set. Working around it is ugly any way around - DBI should +be fixed. (only affects RDBMS which return uppercase column names) + =head1 SEE ALSO L, L, L diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 2cee65d11..88d733829 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -3,19 +3,19 @@ package FS::UID; use strict; use vars qw( @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user - $conf_dir $secrets $datasrc $db_user $db_pass %callback + $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name ); use subs qw( getsecrets cgisetotaker ); use Exporter; -use Carp; +use Carp qw(carp croak cluck); use DBI; use FS::Conf; @ISA = qw(Exporter); @EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup - adminsuidsetup getotaker dbh datasrc getsecrets ); + adminsuidsetup getotaker dbh datasrc getsecrets driver_name ); $freeside_uid = scalar(getpwnam('freeside')); @@ -39,6 +39,8 @@ FS::UID - Subroutines for database login and assorted other stuff $datasrc = datasrc; + $driver_name = driver_name; + =head1 DESCRIPTION Provides a hodgepodge of subroutines. @@ -89,8 +91,8 @@ sub adminsuidsetup { =item cgisuidsetup CGI_object -Stores the CGI (see L) object for later use. (CGI::Base is depriciated) -Runs adminsuidsetup. +Takes a single argument, which is a CGI (see L) or Apache (see L) +object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup. =cut @@ -138,10 +140,16 @@ sub datasrc { $datasrc; } -#hack for web demo -#sub setdbh { -# $dbh=$_[0]; -#} +=item driver_name + +Returns just the driver name portion of the DBI data source. + +=cut + +sub driver_name { + return $driver_name if defined $driver_name; + $driver_name = ( split(':', $datasrc) )[1]; +} sub suidsetup { croak "suidsetup depriciated"; @@ -160,7 +168,8 @@ sub getotaker { =item cgisetotaker Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm -object. Support for CGI::Base and derived classes is depriciated. +object (see L) or an Apache object (see L). Support for CGI::Base +and derived classes is depriciated. =cut @@ -229,6 +238,7 @@ sub getsecrets { ($datasrc, $db_user, $db_pass) = $conf->config($secrets) or die "Can't get secrets: $!"; $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc"; + undef $driver_name; ($datasrc, $db_user, $db_pass); } @@ -246,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.2 2000-05-13 21:50:12 ivan Exp $ +$Id: UID.pm,v 1.3 2000-06-23 12:25:59 ivan Exp $ =head1 BUGS diff --git a/TODO b/TODO index aaa90d452..5478707ef 100644 --- a/TODO +++ b/TODO @@ -1,4 +1,4 @@ -$Id: TODO,v 1.44 2000-06-15 14:45:38 ivan Exp $ +$Id: TODO,v 1.45 2000-06-23 12:25:59 ivan Exp $ If you are interested in helping with any of these, please join the mailing list (send a blank message to ivan-freeside-subscribe@sisd.com) to avoid @@ -445,8 +445,8 @@ was happy with it could go in FS::Record::_quote, for data going into the database. our data display problem might be a Freeside problem wrt not using -Oracle-compatible DBI syntax (uses the return value from $sth->execute as -a number of rows). Fixing this is on the TODO. +Oracle-compatible DBI syntax (fixed using the return value from $sth->execute +as a number of rows - something else?). hooks for arbitrary commands out of configuration files svc_acct.pm svc_acct_sm.pm etc. @@ -575,8 +575,6 @@ the web interface in general needs to be redone in a more abstract way. false laziness: some of search/svc_acct_sm.cgi was copied to search/svc_domain.cgi. but web interface in general needs to be rewritten in a mucho cleaner way. -Portability: in FS::Record, $sth->execute does not return a number of rows for all DBD's. see man DBI - subroutine the where clause (eventually all SQL) as OO perhaps (has anyone done this?) add a select method to FS::Record? -- 2.11.0