X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=2c745b4137a599ac31749ed340a4a2a5b40ee081;hp=426bea2f8a9d4f8b4a74f428ecc822826961f343;hb=6ef34dda51afba96d8dc6c4dd72427c3d4003945;hpb=410ece2d77e913892a6fe92e8abbc9271b324dc1

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 426bea2f8..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 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,7 +171,7 @@ objects.
 
 sub qsearch {
   my($table, $record, $select, $extra_sql ) = @_;
-  $table =~ /^([\w\_])+$/ or die "Illegal table: $table";
+  $table =~ /^([\w\_]+)$/ or die "Illegal table: $table";
   $table = $1;
   $select ||= '*';
   my $dbh = dbh;
@@ -198,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);' ) {
@@ -315,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);
@@ -562,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!";
@@ -573,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;
@@ -727,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);
@@ -736,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);
   }
   '';
 }
@@ -787,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<Locale::Country>.
+
 =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.
@@ -797,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);
   '';
@@ -827,6 +879,8 @@ sub fields {
   $table_obj->columns;
 }
 
+=back
+
 =head1 SUBROUTINES
 
 =over 4
@@ -915,7 +969,7 @@ sub DESTROY { return; }
 
 =head1 VERSION
 
-$Id: Record.pm,v 1.15 2001-05-07 15:36:04 ivan Exp $
+$Id: Record.pm,v 1.25 2001-08-21 09:34:13 ivan Exp $
 
 =head1 BUGS
 
@@ -945,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.
 
@@ -958,6 +1012,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<DBIx::DBSchema>, L<FS::UID>, L<DBI>