*** empty log message ***

[freeside.git] / site_perl / Record.pm

diff --git a/site_perl/Record.pm b/site_perl/Record.pm
index 0f098b4..6496d3c 100644 (file)
--- a/site_perl/Record.pm
+++ b/site_perl/Record.pm
@@ -122,11 +122,12 @@ sub new {
 
   foreach my $field ( $self->fields ) { 
     $hashref->{$field}='' unless defined $hashref->{$field};
-    #trim the '$' from money fields for Pg (belong HERE?)
+    #trim the '$' and ',' from money fields for Pg (belong HERE?)
     #(what about Pg i18n?)
     if ( datasrc =~ m/Pg/ 
          && $self->dbdef_table->column($field)->type eq 'money' ) {
       ${$hashref}{$field} =~ s/^\$//;
+      ${$hashref}{$field} =~ s/\,//;
     }
   }
 
@@ -166,13 +167,17 @@ sub qsearch {
     ? " WHERE ". join(' AND ',
       map {
         $record->{$_} eq ''
-          ? "$_ IS NULL"
+          ? ( datasrc =~ m/Pg/
+                ? "$_ IS NULL"
+                : "( $_ IS NULL OR $_ = \"\" )"
+            )
           : "$_ = ". _quote($record->{$_},$table,$_)
       } @fields
     ) : ''
   );
   $sth=$dbh->prepare($statement)
     or croak $dbh->errstr; #is that a little too harsh?  hmm.
+  #warn $statement #if $debug # or some such;
 
   if ( eval ' scalar(@FS::'. $table. '::ISA);' ) {
     map {
@@ -353,6 +358,7 @@ sub insert {
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
 
   $sth->execute or return $sth->errstr;
 
@@ -383,7 +389,11 @@ sub delete {
   my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ',
     map {
       $self->getfield($_) eq ''
-        ? "$_ IS NULL"
+        #? "( $_ IS NULL OR $_ = \"\" )"
+        ? ( datasrc =~ m/Pg/
+              ? "$_ IS NULL"
+              : "( $_ IS NULL OR $_ = \"\" )"
+          )
         : "$_ = ". _quote($self->getfield($_),$self->table,$_)
     } ( $self->dbdef_table->primary_key )
           ? ( $self->dbdef_table->primary_key)
@@ -396,6 +406,7 @@ sub delete {
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
@@ -450,7 +461,11 @@ sub replace {
     join(' AND ',
       map {
         $old->getfield($_) eq ''
-          ? "$_ IS NULL"
+          #? "( $_ IS NULL OR $_ = \"\" )"
+          ? ( datasrc =~ m/Pg/
+                ? "$_ IS NULL"
+                : "( $_ IS NULL OR $_ = \"\" )"
+            )
           : "$_ = ". _quote($old->getfield($_),$old->table,$_)
       } ( $primary_key ? ( $primary_key ) : $old->fields )
     )
@@ -462,6 +477,7 @@ sub replace {
   local $SIG{QUIT} = 'IGNORE'; 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
 
   my $rc = $sth->execute or return $sth->errstr;
   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
@@ -546,7 +562,7 @@ sub ut_float {
    $self->getfield($field) =~ /^(\d+)$/ ||
    $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
    $self->getfield($field) =~ /^(\d+e\d+)$/)
-    or return "Illegal or empty (float) $field!";
+    or return "Illegal or empty (float) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -561,7 +577,7 @@ is an error, returns the error, otherwise returns false.
 sub ut_number {
   my($self,$field)=@_;
   $self->getfield($field) =~ /^(\d+)$/
-    or return "Illegal or empty (numeric) $field!";
+    or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -576,7 +592,7 @@ an error, returns the error, otherwise returns false.
 sub ut_numbern {
   my($self,$field)=@_;
   $self->getfield($field) =~ /^(\d*)$/
-    or return "Illegal (numeric) $field!";
+    or return "Illegal (numeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -590,9 +606,11 @@ is an error, returns the error, otherwise returns false.
 
 sub ut_money {
   my($self,$field)=@_;
+  $self->setfield($field, 0) if $self->getfield($field) eq '';
   $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
-    or return "Illegal (money) $field!";
-  $self->setfield($field,"$1$2$3" || 0);
+    or return "Illegal (money) $field: ". $self->getfield($field);
+  #$self->setfield($field, "$1$2$3" || 0);
+  $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
   '';
 }
 
@@ -608,7 +626,7 @@ false.
 sub ut_text {
   my($self,$field)=@_;
   $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
-    or return "Illegal or empty (text) $field";
+    or return "Illegal or empty (text) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -624,7 +642,7 @@ May be null.  If there is an error, returns the error, otherwise returns false.
 sub ut_textn {
   my($self,$field)=@_;
   $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
-    or return "Illegal (text) $field";
+    or return "Illegal (text) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -639,7 +657,8 @@ an error, returns the error, otherwise returns false.
 sub ut_alpha {
   my($self,$field)=@_;
   $self->getfield($field) =~ /^(\w+)$/
-    or return "Illegal or empty (alphanumeric) $field!";
+    or return "Illegal or empty (alphanumeric) $field: ".
+              $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -654,7 +673,7 @@ error, returns the error, otherwise returns false.
 sub ut_alphan {
   my($self,$field)=@_;
   $self->getfield($field) =~ /^(\w*)$/ 
-    or return "Illegal (alphanumeric) $field!";
+    or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -674,7 +693,7 @@ sub ut_phonen {
   } else {
     $phonen =~ s/\D//g;
     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
-      or return "Illegal (phone) $field!";
+      or return "Illegal (phone) $field: ". $self->getfield($field);
     $phonen = "$1-$2-$3";
     $phonen .= " x$4" if $4;
     $self->setfield($field,$phonen);
@@ -690,7 +709,8 @@ Untaints arbitrary data.  Be careful.
 
 sub ut_anything {
   my($self,$field)=@_;
-  $self->getfield($field) =~ /^(.*)$/ or return "Illegal $field!";
+  $self->getfield($field) =~ /^(.*)$/
+    or return "Illegal $field: ". $self->getfield($field);
   $self->setfield($field,$1);
   '';
 }
@@ -805,7 +825,7 @@ sub hfields {
 
 =head1 VERSION
 
-$Id: Record.pm,v 1.10 1998-12-29 11:59:33 ivan Exp $
+$Id: Record.pm,v 1.16 1999-04-10 07:03:38 ivan Exp $
 
 =head1 BUGS
 
@@ -927,7 +947,26 @@ added pod documentation ivan@sisd.com 98-sep-6
 ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
 
 $Log: Record.pm,v $
-Revision 1.10  1998-12-29 11:59:33  ivan
+Revision 1.16  1999-04-10 07:03:38  ivan
+return the value with ut_* error messages, to assist in debugging
+
+Revision 1.15  1999/04/08 12:08:59  ivan
+fix up PostgreSQL money fields so you can actually use them as numbers.  bah.
+
+Revision 1.14  1999/04/07 14:58:31  ivan
+more kludges to get around different null/empty handling in Perl vs. MySQL vs.
+PostgreSQL etc.
+
+Revision 1.13  1999/03/29 11:55:43  ivan
+eliminate warnings in ut_money
+
+Revision 1.12  1999/01/25 12:26:06  ivan
+yet more mod_perl stuff
+
+Revision 1.11  1999/01/18 09:22:38  ivan
+changes to track email addresses for email invoicing
+
+Revision 1.10  1998/12/29 11:59:33  ivan
 mostly properly OO, some work still to be done with svc_ stuff
 
 Revision 1.9  1998/11/21 07:26:45  ivan