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/\,//;
}
}
? " WHERE ". join(' AND ',
map {
$record->{$_} eq ''
- ? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( 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 {
my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ',
map {
$self->getfield($_) eq ''
- ? "( $_ IS NULL OR $_ = \"\" )"
+ #? "( $_ 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)
join(' AND ',
map {
$old->getfield($_) eq ''
- ? "( $_ IS NULL OR $_ = \"\" )"
+ #? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( datasrc =~ m/Pg/
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
: "$_ = ". _quote($old->getfield($_),$old->table,$_)
} ( $primary_key ? ( $primary_key ) : $old->fields )
)
$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);
'';
}
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);
'';
}
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);
'';
}
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);
'';
}
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);
'';
}
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);
'';
}
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);
'';
}
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);
'';
}
} 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);
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);
'';
}
=head1 VERSION
-$Id: Record.pm,v 1.12 1999-01-25 12:26:06 ivan Exp $
+$Id: Record.pm,v 1.16 1999-04-10 07:03:38 ivan Exp $
=head1 BUGS
ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
$Log: Record.pm,v $
-Revision 1.12 1999-01-25 12:26:06 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