X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=2c745b4137a599ac31749ed340a4a2a5b40ee081;hp=dd8cc542c803ec30f4396c73b5e24827f5331dd8;hb=6ef34dda51afba96d8dc6c4dd72427c3d4003945;hpb=d220c8a4bfa1aee8f17ed71c2dba655160dd3595 diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index dd8cc542c..2c745b413 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -6,8 +6,9 @@ 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 driver_name); -use FS::dbdef; +use Locale::Country; +use DBIx::DBSchema; +use FS::UID qw(dbh checkruid getotaker datasrc driver_name); @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); @@ -73,7 +74,8 @@ FS::Record - Database record objects $value = $record->ut_alpha('column'); $value = $record->ut_alphan('column'); $value = $record->ut_phonen('column'); - $value = $record->ut_anythingn('column'); + $value = $record->ut_anything('column'); + $value = $record->ut_name('column'); $dbdef = reload_dbdef; $dbdef = reload_dbdef "/non/standard/filename"; @@ -126,7 +128,7 @@ sub new { $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' + if ( driver_name =~ /^Pg$/i && $self->dbdef_table->column($field)->type eq 'money' ) { ${$hashref}{$field} =~ s/^\$//; ${$hashref}{$field} =~ s/\,//; @@ -169,6 +171,8 @@ objects. sub qsearch { my($table, $record, $select, $extra_sql ) = @_; + $table =~ /^([\w\_]+)$/ or die "Illegal table: $table"; + $table = $1; $select ||= '*'; my $dbh = dbh; @@ -178,7 +182,7 @@ sub qsearch { if ( @fields ) { $statement .= ' WHERE '. join(' AND ', map { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { - if ( driver_name eq 'Pg' ) { + if ( driver_name =~ /^Pg$/i ) { "$_ IS NULL"; } else { qq-( $_ IS NULL OR $_ = "" )-; @@ -191,12 +195,12 @@ sub qsearch { $statement .= " $extra_sql" if defined($extra_sql); warn $statement if $DEBUG; - my $sth = $dbh->prepare_cached($statement) + my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; $sth->execute( map $record->{$_}, grep defined( $record->{$_} ) && $record->{$_} ne '', @fields - ) or croak $dbh->errstr; + ) or croak "Error executing \"$statement\": ". $dbh->errstr; $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit; if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { @@ -313,6 +317,8 @@ sub AUTOLOAD { my($field)=$AUTOLOAD; $field =~ s/.*://; if ( defined($value) ) { + confess "errant AUTOLOAD $field for $self (arg $value)" + unless $self->can('setfield'); $self->setfield($field,$value); } else { $self->getfield($field); @@ -419,7 +425,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -492,7 +498,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -541,7 +547,7 @@ sub check { =item unique COLUMN Replaces COLUMN in record with a unique number. Called by the B method -on primary keys and single-field unique columns (see L). +on primary keys and single-field unique columns (see L). Returns the new value. =cut @@ -560,7 +566,6 @@ sub unique { #warn "table $table is tainted" if is_tainted($table); #warn "field $field is tainted" if is_tainted($field); - &swapuid; my($counter) = new File::CounterFile "$table.$field",0; # hack for web demo # getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!"; @@ -571,7 +576,6 @@ sub unique { my($index)=$counter->inc; $index=$counter->inc while qsearchs($table,{$field=>$index}); #just in case - &swapuid; $index =~ /^(\d*)$/; $index=$1; @@ -725,7 +729,7 @@ sub ut_phonen { my $phonen = $self->getfield($field); if ( $phonen eq '' ) { $self->setfield($field,''); - } elsif ( $country eq 'US' ) { + } elsif ( $country eq 'US' || $country eq 'CA' ) { $phonen =~ s/\D//g; $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/ or return "Illegal (phone) $field: ". $self->getfield($field); @@ -734,7 +738,7 @@ sub ut_phonen { $self->setfield($field,$phonen); } else { warn "don't know how to check phone numbers for country $country"; - return $self->ut_alphan($field); + return $self->ut_textn($field); } ''; } @@ -785,8 +789,58 @@ sub ut_domain { ''; } +=item ut_name COLUMN + +Check/untaint proper names; allows alphanumerics, spaces and the following +punctuation: , . - ' + +May not be null. + +=cut + +sub ut_name { + my( $self, $field ) = @_; + $self->getfield($field) =~ /^([\w \,\.\-\']+)$/ + or return "Illegal (name) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_zip COLUMN + +Check/untaint zip codes. + +=cut + +sub ut_zip { + my( $self, $field ) = @_; + $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ + or return "Illegal (zip) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_country COLUMN + +Check/untaint country codes. Country names are changed to codes, if possible - +see L. + =cut +sub ut_country { + my( $self, $field ) = @_; + unless ( $self->getfield($field) =~ /^(\w\w)$/ ) { + if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/ + && country2code($1) ) { + $self->setfield($field,uc(country2code($1))); + } + } + $self->getfield($field) =~ /^(\w\w)$/ + or return "Illegal (country) $field: ". $self->getfield($field); + $self->setfield($field,uc($1)); + ''; +} + =item ut_anything COLUMN Untaints arbitrary data. Be careful. @@ -795,7 +849,7 @@ Untaints arbitrary data. Be careful. sub ut_anything { my($self,$field)=@_; - $self->getfield($field) =~ /^(.*)$/ + $self->getfield($field) =~ /^(.*)$/s or return "Illegal $field: ". $self->getfield($field); $self->setfield($field,$1); ''; @@ -805,7 +859,7 @@ sub ut_anything { This can be used as both a subroutine and a method call. It returns a list of the columns in this record's table, or an explicitly specified table. -(See L). +(See L). =cut @@ -825,21 +879,23 @@ sub fields { $table_obj->columns; } +=back + =head1 SUBROUTINES =over 4 =item reload_dbdef([FILENAME]) -Load a database definition (see L), optionally from a non-default -filename. This command is executed at startup unless -I<$FS::Record::setup_hack> is true. Returns a FS::dbdef object. +Load a database definition (see L), optionally from a +non-default filename. This command is executed at startup unless +I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. =cut sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = load FS::dbdef ($file); + $dbdef = load DBIx::DBSchema $file; } =item dbdef @@ -913,7 +969,7 @@ sub DESTROY { return; } =head1 VERSION -$Id: Record.pm,v 1.12 2001-02-03 14:03:49 ivan Exp $ +$Id: Record.pm,v 1.25 2001-08-21 09:34:13 ivan Exp $ =head1 BUGS @@ -943,7 +999,7 @@ The ut_money method assumes money has two decimal digits. The Pg money kludge in the new method only strips `$'. -The ut_phonen method assumes US-style phone numbers. +The ut_phonen method only checks US-style phone numbers. The _quote function should probably use ut_float instead of a regex. @@ -956,9 +1012,11 @@ 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) +ut_zip should take an optional country like ut_phone. + =head1 SEE ALSO -L, L, L +L, L, L Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.