X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=a15aaba369351779d820204f9ae6d4be4793ff94;hb=b7cdcea59f34c12f7d181c41014e0d2559bf983c;hp=82f590f94b570786ec97140e45243adb083d00cb;hpb=2066bf9d3ebb4e53c49ab8b4b447c4eb88e425a4;p=freeside.git

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 82f590f94..a15aaba36 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);
@@ -64,17 +65,17 @@ FS::Record - Database record objects
 
     $value = $record->unique('column');
 
-    $value = $record->ut_float('column');
-    $value = $record->ut_number('column');
-    $value = $record->ut_numbern('column');
-    $value = $record->ut_money('column');
-    $value = $record->ut_text('column');
-    $value = $record->ut_textn('column');
-    $value = $record->ut_alpha('column');
-    $value = $record->ut_alphan('column');
-    $value = $record->ut_phonen('column');
-    $value = $record->ut_anythingn('column');
-    $value = $record->ut_name('column');
+    $error = $record->ut_float('column');
+    $error = $record->ut_number('column');
+    $error = $record->ut_numbern('column');
+    $error = $record->ut_money('column');
+    $error = $record->ut_text('column');
+    $error = $record->ut_textn('column');
+    $error = $record->ut_alpha('column');
+    $error = $record->ut_alphan('column');
+    $error = $record->ut_phonen('column');
+    $error = $record->ut_anything('column');
+    $error = $record->ut_name('column');
 
     $dbdef = reload_dbdef;
     $dbdef = reload_dbdef "/non/standard/filename";
@@ -199,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);' ) {
@@ -471,10 +472,11 @@ returns the error, otherwise returns false.
 
 sub replace {
   my ( $new, $old ) = ( shift, shift );
+  warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG;
 
   my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
   unless ( @diff ) {
-    carp "warning: records identical";
+    carp "[warning][FS::Record] $new -> replace $old: records identical";
     return '';
   }
 
@@ -565,7 +567,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!";
@@ -576,7 +577,6 @@ sub unique {
   my($index)=$counter->inc;
   $index=$counter->inc
     while qsearchs($table,{$field=>$index}); #just in case
-  &swapuid;
 
   $index =~ /^(\d*)$/;
   $index=$1;
@@ -730,7 +730,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);
@@ -739,7 +739,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);
   }
   '';
 }
@@ -814,10 +814,38 @@ 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<Locale::Country>.
+
+=cut
+
+sub ut_country {
   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);
+  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));
   '';
 }
 
@@ -828,13 +856,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
@@ -855,7 +900,7 @@ sub fields {
   }
   #croak "Usage: \@fields = fields(\$table)\n   or: \@fields = \$record->fields" unless $table;
   my($table_obj) = $dbdef->table($table);
-  croak "Unknown table $table" unless $table_obj;
+  confess "Unknown table $table" unless $table_obj;
   $table_obj->columns;
 }
 
@@ -949,7 +994,7 @@ sub DESTROY { return; }
 
 =head1 VERSION
 
-$Id: Record.pm,v 1.19 2001-07-30 10:41:44 ivan Exp $
+$Id: Record.pm,v 1.30 2001-10-10 05:24:25 ivan Exp $
 
 =head1 BUGS