shipping address additions

[freeside.git] / FS / FS / Record.pm

diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index b5f33e1..82f590f 100644 (file)
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -6,8 +6,8 @@ use subs qw(reload_dbdef);
 use Exporter;
 use Carp qw(carp cluck croak confess);
 use File::CounterFile;
+use DBIx::DBSchema;
 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);
@@ -74,6 +74,7 @@ FS::Record - Database record objects
     $value = $record->ut_alphan('column');
     $value = $record->ut_phonen('column');
     $value = $record->ut_anythingn('column');
+    $value = $record->ut_name('column');
 
     $dbdef = reload_dbdef;
     $dbdef = reload_dbdef "/non/standard/filename";
@@ -126,7 +127,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 +170,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 +181,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 $_ = "" )-;
@@ -313,6 +316,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 +424,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 +497,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 +546,7 @@ sub check {
 =item unique COLUMN
 
 Replaces COLUMN in record with a unique number.  Called by the B<add> method
-on primary keys and single-field unique columns (see L<FS::dbdef_table>).
+on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
 Returns the new value.
 
 =cut
@@ -785,8 +790,37 @@ 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_anything COLUMN
 
 Untaints arbitrary data.  Be careful.
@@ -805,7 +839,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<FS::dbdef_table>).
+(See L<DBIx::DBSchema::Table>).
 
 =cut
 
@@ -825,21 +859,23 @@ sub fields {
   $table_obj->columns;
 }
 
+=back
+
 =head1 SUBROUTINES
 
 =over 4
 
 =item reload_dbdef([FILENAME])
 
-Load a database definition (see L<FS::dbdef>), 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<DBIx::DBSchema>), 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 +949,7 @@ sub DESTROY { return; }
 
 =head1 VERSION
 
-$Id: Record.pm,v 1.13 2001-02-20 16:31:06 ivan Exp $
+$Id: Record.pm,v 1.19 2001-07-30 10:41:44 ivan Exp $
 
 =head1 BUGS
 
@@ -943,7 +979,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 +992,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<FS::dbdef>, L<FS::UID>, L<DBI>
+L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
 
 Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.