summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
27649e6)
a number of rows, uses placeholders and prepare_cached
Kenny Elliott <kenny@neoserve.com> contributed ICRADIUS radreply table support,
allowing attributes with ICRADIUS.
Kenny Elliott <kenny@neoserve.com> contributed ICRADIUS radreply table support,
allowing attributes with ICRADIUS.
+Stephen Amadei <amadei@dandy.net> contribued portability cleanups for the
+low-level DBI stuff.
+
Everything else is my (Ivan Kohler <ivan@420.am>) fault.
Everything else is my (Ivan Kohler <ivan@420.am>) fault.
package FS::Record;
use strict;
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 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);
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
#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;
#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;
$hashref->{$field}='' unless defined $hashref->{$field};
#trim the '$' and ',' from money fields for Pg (belong HERE?)
#(what about Pg i18n?)
$hashref->{$field}='' unless defined $hashref->{$field};
#trim the '$' and ',' from money fields for Pg (belong HERE?)
#(what about Pg i18n?)
+ if ( driver_name eq 'Pg'
&& $self->dbdef_table->column($field)->type eq 'money' ) {
${$hashref}{$field} =~ s/^\$//;
${$hashref}{$field} =~ s/\,//;
&& $self->dbdef_table->column($field)->type eq 'money' ) {
${$hashref}{$field} =~ s/^\$//;
${$hashref}{$field} =~ s/\,//;
- 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( {} )};
+ }
- cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects";
+ cluck "warning: FS::$table not loaded; returning FS::Record objects";
- new FS::Record ($table,$sth->fetchrow_hashref);
- } ( 1 .. $sth->execute );
+ FS::Record->new( $table, { %{$_} } );
+ } @{$sth->fetchall_arrayref( {} )};
map {
$self->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
map {
$self->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( driver_name eq 'Pg'
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
map {
$old->getfield($_) eq ''
#? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( driver_name eq 'Pg'
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
? "$_ IS NULL"
: "( $_ IS NULL OR $_ = \"\" )"
)
-$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 $
ut_sqltype (like ut_varchar) should all be defined
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.
The ut_money method assumes money has two decimal digits.
Probably should borrow/use some dbdef methods where appropriate (like sub
fields)
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>
=head1 SEE ALSO
L<FS::dbdef>, L<FS::UID>, L<DBI>
use strict;
use vars qw(
@ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
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 subs qw(
getsecrets cgisetotaker
);
use Exporter;
+use Carp qw(carp croak cluck);
use DBI;
use FS::Conf;
@ISA = qw(Exporter);
@EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
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'));
$freeside_uid = scalar(getpwnam('freeside'));
+ $driver_name = driver_name;
+
=head1 DESCRIPTION
Provides a hodgepodge of subroutines.
=head1 DESCRIPTION
Provides a hodgepodge of subroutines.
=item cgisuidsetup CGI_object
=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.
-#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";
sub suidsetup {
croak "suidsetup depriciated";
=item cgisetotaker
Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
=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.
($datasrc, $db_user, $db_pass) = $conf->config($secrets)
or die "Can't get secrets: $!";
$FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
($datasrc, $db_user, $db_pass) = $conf->config($secrets)
or die "Can't get secrets: $!";
$FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
($datasrc, $db_user, $db_pass);
}
($datasrc, $db_user, $db_pass);
}
-$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 $
-$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
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
database.
our data display problem might be a Freeside problem wrt not using
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.
hooks for arbitrary commands out of configuration files
svc_acct.pm svc_acct_sm.pm etc.
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.
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?
subroutine the where clause (eventually all SQL) as OO perhaps (has anyone done this?)
add a select method to FS::Record?