X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=site_perl%2FRecord.pm;h=5d69619ef896034b80dedc6109e78ace4128b40f;hb=21707d8773402d92c6b6dd3aef034e8ac0f12cb2;hp=4634026b862997ce91df86ee688e8d56cfb93a07;hpb=35efa918b163f10c1bdcc70087653f8be00b3bc5;p=freeside.git diff --git a/site_perl/Record.pm b/site_perl/Record.pm index 4634026b8..5d69619ef 100644 --- 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/\,//; } } @@ -503,7 +504,7 @@ Not yet implemented, croaks. Derived classes should provide a check method. =cut sub check { - croak "FS::Record::check not implemented; supply one in subclass!"; + confess "FS::Record::check not implemented; supply one in subclass!"; } =item unique COLUMN @@ -561,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); ''; } @@ -576,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); ''; } @@ -591,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); ''; } @@ -607,7 +608,7 @@ 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!"; + or return "Illegal (money) $field: ". $self->getfield($field); #$self->setfield($field, "$1$2$3" || 0); $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0); ''; @@ -625,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); ''; } @@ -641,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); ''; } @@ -656,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); ''; } @@ -671,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); ''; } @@ -691,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); @@ -707,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); ''; } @@ -822,7 +825,7 @@ sub hfields { =head1 VERSION -$Id: Record.pm,v 1.14 1999-04-07 14:58:31 ivan Exp $ +$Id: Record.pm,v 1.17 1999-07-17 01:34:25 ivan Exp $ =head1 BUGS @@ -944,7 +947,16 @@ 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.14 1999-04-07 14:58:31 ivan +Revision 1.17 1999-07-17 01:34:25 ivan +s/croak/confess/; in check method + +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.