X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=59472c898be12b76274372a207af0e70a39a556e;hp=dae9f370732255791662ce5bd5b17c2d9b3e364d;hb=7f07089722bfcabe3bf42619bb2bdb81fd8d44e1;hpb=12debb17cbd12e68261dc7f98e39bfbc3915e6f6 diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index dae9f3707..59472c898 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,17 +1,19 @@ 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; @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 +126,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 +159,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 ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { + 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 defined( $record->{$_} ) && $record->{$_} ne '', @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 +405,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( datasrc =~ m/Pg/ + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -462,7 +477,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( datasrc =~ m/Pg/ + ? ( driver_name eq 'Pg' ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -678,29 +693,84 @@ sub ut_alphan { ''; } -=item ut_phonen COLUMN +=item ut_phonen COLUMN [ COUNTRY ] Check/untaint phone numbers. May be null. If there is an error, returns the error, otherwise returns false. +Takes an optional two-letter ISO country code; without it or with unsupported +countries, ut_phonen simply calls ut_alphan. + =cut sub ut_phonen { - my($self,$field)=@_; + my( $self, $field, $country ) = @_; + return $self->ut_alphan($field) unless defined $country; my $phonen = $self->getfield($field); if ( $phonen eq '' ) { $self->setfield($field,''); - } else { + } elsif ( $country eq 'US' ) { $phonen =~ s/\D//g; $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/ or return "Illegal (phone) $field: ". $self->getfield($field); $phonen = "$1-$2-$3"; $phonen .= " x$4" if $4; $self->setfield($field,$phonen); + } else { + warn "don't know how to check phone numbers for country $country"; + return $self->ut_alphan($field); } ''; } +=item ut_ip COLUMN + +Check/untaint ip addresses. IPv4 only for now. + +=cut + +sub ut_ip { + my( $self, $field ) = @_; + $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ + or return "Illegal (IP address) $field: ". $self->getfield($field); + for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; } + $self->setfield($field, "$1.$2.$3.$3"); + ''; +} + +=item ut_ipn COLUMN + +Check/untaint ip addresses. IPv4 only for now. May be null. + +=cut + +sub ut_ipn { + my( $self, $field ) = @_; + if ( $self->getfield($field) =~ /^()$/ ) { + $self->setfield($field,''); + ''; + } else { + $self->ut_ip($field); + } +} + +=item ut_domain COLUMN + +Check/untaint host and domain names. + +=cut + +sub ut_domain { + my( $self, $field ) = @_; + #$self->getfield($field) =~/^(\w+\.)*\w+$/ + $self->getfield($field) =~/^(\w+\.)*\w+$/ + or return "Illegal (domain) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=cut + =item ut_anything COLUMN Untaints arbitrary data. Be careful. @@ -825,7 +895,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.3 2000-03-03 18:21:38 ivan Exp $ +$Id: Record.pm,v 1.9 2000-11-07 15:00:37 ivan Exp $ =head1 BUGS @@ -849,7 +919,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 +934,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