use strict;
use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me );
+ $me %dbdef_cache );
use subs qw(reload_dbdef);
use Exporter;
use Carp qw(carp cluck croak confess);
my $hashref = $self->{'Hash'} = shift;
- foreach my $field ( $self->fields ) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- #trim the '$' and ',' from money fields for Pg (belong HERE?)
- #(what about Pg i18n?)
- if ( driver_name =~ /^Pg$/i
- && $self->dbdef_table->column($field)->type eq 'money' ) {
- ${$hashref}{$field} =~ s/^\$//;
- ${$hashref}{$field} =~ s/\,//;
- }
+ foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) {
+ $hashref->{$field}='';
}
$self->_cache($hashref, shift) if $self->can('_cache') && @_;
}
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
- if ( driver_name =~ /^Pg$/i ) {
- qq-( $_ IS NULL OR $_ = '' )-;
+ if ( $op eq '=' ) {
+ if ( driver_name =~ /^Pg$/i ) {
+ qq-( $_ IS NULL OR $_ = '' )-;
+ } else {
+ qq-( $_ IS NULL OR $_ = "" )-;
+ }
+ } elsif ( $op eq '!=' ) {
+ if ( driver_name =~ /^Pg$/i ) {
+ qq-( $_ IS NOT NULL AND $_ != '' )-;
+ } else {
+ qq-( $_ IS NOT NULL AND $_ != "" )-;
+ }
} else {
- qq-( $_ IS NULL OR $_ = "" )-;
+ if ( driver_name =~ /^Pg$/i ) {
+ qq-( $_ $op '' )-;
+ } else {
+ qq-( $_ $op "" )-;
+ }
}
} else {
"$_ $op ?";
}
$statement .= " $extra_sql" if defined($extra_sql);
- warn "[debug]$me $statement\n" if $DEBUG;
+ warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = $dbh->prepare($statement)
or croak "$dbh->errstr doing $statement";
join( ', ', @values ).
")"
;
- warn "[debug]$me $statement\n" if $DEBUG;
+ warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_sth;
if ( defined $dbdef->table('h_'. $self->table) ) {
my $h_statement = $self->_h_statement('insert');
- warn "[debug]$me $h_statement\n" if $DEBUG;
+ warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or return dbh->errstr;
} else {
$h_sth = '';
? ( $self->dbdef_table->primary_key)
: $self->fields
);
- warn "[debug]$me $statement\n" if $DEBUG;
+ warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_sth;
if ( defined $dbdef->table('h_'. $self->table) ) {
my $h_statement = $self->_h_statement('delete');
- warn "[debug]$me $h_statement\n" if $DEBUG;
+ warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or return dbh->errstr;
} else {
$h_sth = '';
} ( $primary_key ? ( $primary_key ) : $old->fields )
)
;
- warn "[debug]$me $statement\n" if $DEBUG;
+ warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_old_sth;
if ( defined $dbdef->table('h_'. $old->table) ) {
my $h_old_statement = $old->_h_statement('replace_old');
- warn "[debug]$me $h_old_statement\n" if $DEBUG;
+ warn "[debug]$me $h_old_statement\n" if $DEBUG > 2;
$h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
} else {
$h_old_sth = '';
my $h_new_sth;
if ( defined $dbdef->table('h_'. $new->table) ) {
my $h_new_statement = $new->_h_statement('replace_new');
- warn "[debug]$me $h_new_statement\n" if $DEBUG;
+ warn "[debug]$me $h_new_statement\n" if $DEBUG > 2;
$h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
} else {
$h_new_sth = '';
my($self,$field) = @_;
my($table)=$self->table;
- croak("&FS::UID::checkruid failed") unless &checkruid;
+ #croak("&FS::UID::checkruid failed") unless &checkruid;
croak "Unique called on field $field, but it is ",
$self->getfield($field),
sub reload_dbdef {
my $file = shift || $dbdef_file;
- $dbdef = load DBIx::DBSchema $file
- or die "can't load database schema from $file";
+
+ unless ( exists $dbdef_cache{$file} ) {
+ warn "[debug]$me loading dbdef for $file\n" if $DEBUG;
+ $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
+ or die "can't load database schema from $file";
+ } else {
+ warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG;
+ }
+ $dbdef = $dbdef_cache{$file};
}
=item dbdef
my($dbh)=dbh;
if ( $value =~ /^\d+(\.\d+)?$/ &&
# ! ( datatype($table,$field) =~ /^char/ )
- ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i )
+ ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i
) {
$value;
} else {