summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/Record.pm86
-rw-r--r--FS/FS/UID.pm32
2 files changed, 74 insertions, 44 deletions
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<FS::dbdef>, L<FS::UID>, L<DBI>
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<CGI>) object for later use. (CGI::Base is depriciated)
-Runs adminsuidsetup.
+Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
+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<CGI>) or an Apache object (see L<Apache>). 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
generated by cgit v1.2.1 (git 2.18.0) at 2025-10-31 16:37:47 +0000