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 {
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
$sth->execute or return $sth->errstr;
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)
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";
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 )
)
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";
=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
$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);
'';
}
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);
'';
}
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.11 1999-01-18 09:22:38 ivan Exp $
+$Id: Record.pm,v 1.17 1999-07-17 01:34:25 ivan Exp $
=head1 BUGS
ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
$Log: Record.pm,v $
-Revision 1.11 1999-01-18 09:22:38 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.
+
+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