X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=b476df2c0cd2f0509f28188d22a4059829ea4b3a;hp=113e1a18df73519212cb1cb801dc46d80101249d;hb=f5266a4d07d116efd732f433d0f4f3a47b143a7d;hpb=018f6678557506e68cc6b8643862143cc332f7da diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 113e1a18d..b476df2c0 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 Locale::Country; use DBIx::DBSchema; -use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); +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"; @@ -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; @@ -196,7 +200,7 @@ sub qsearch { $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); @@ -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,65 @@ 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, $country ) = @_; + if ( $country eq 'US' ) { + $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/ + or return "Illegal (zip) $field for country $country: ". + $self->getfield($field); + $self->setfield($field,$1); + } else { + $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. @@ -794,13 +855,30 @@ Untaints arbitrary data. Be careful. =cut sub ut_anything { - my($self,$field)=@_; - $self->getfield($field) =~ /^(.*)$/ + my( $self, $field ) = @_; + $self->getfield($field) =~ /^(.*)$/s or return "Illegal $field: ". $self->getfield($field); $self->setfield($field,$1); ''; } +=item ut_enum COLUMN CHOICES_ARRAYREF + +Check/untaint a column, supplying all possible choices, like the "enum" type. + +=cut + +sub ut_enum { + my( $self, $field, $choices ) = @_; + foreach my $choice ( @$choices ) { + if ( $self->getfield($field) eq $choice ) { + $self->setfield($choice); + return ''; + } + } + return "Illegal (enum) field $field: ". $self->getfield($field); +} + =item fields [ TABLE ] This can be used as both a subroutine and a method call. It returns a list @@ -825,6 +903,8 @@ sub fields { $table_obj->columns; } +=back + =head1 SUBROUTINES =over 4 @@ -913,7 +993,7 @@ sub DESTROY { return; } =head1 VERSION -$Id: Record.pm,v 1.14 2001-04-15 12:56:30 ivan Exp $ +$Id: Record.pm,v 1.27 2001-09-11 00:08:18 ivan Exp $ =head1 BUGS @@ -943,7 +1023,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,6 +1036,8 @@ 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