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);
use DBIx::DBSchema 0.19;
use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
use FS::SearchCache;
+use FS::Msgcat qw(gettext);
@ISA = qw(Exporter);
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
}
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 ?";
=cut
# readable/safe
-#sub AUTOLOAD {
-# my($self,$value)=@_;
-# my($field)=$AUTOLOAD;
-# $field =~ s/.*://;
-# if ( defined($value) ) {
-# confess "errant AUTOLOAD $field for $self (arg $value)"
-# unless $self->can('setfield');
-# $self->setfield($field,$value);
-# } else {
-# confess "errant AUTOLOAD $field for $self (no args)"
-# unless $self->can('getfield');
-# $self->getfield($field);
-# }
-#}
-
-# efficient
sub AUTOLOAD {
- my $field = $AUTOLOAD;
+ my($self,$value)=@_;
+ my($field)=$AUTOLOAD;
$field =~ s/.*://;
- if ( defined($_[1]) ) {
- $_[0]->setfield($field, $_[1]);
+ if ( defined($value) ) {
+ confess "errant AUTOLOAD $field for $self (arg $value)"
+ unless $self->can('setfield');
+ $self->setfield($field,$value);
} else {
- $_[0]->getfield($field);
+ confess "errant AUTOLOAD $field for $self (no args)"
+ unless $self->can('getfield');
+ $self->getfield($field);
}
}
+# efficient
+#sub AUTOLOAD {
+# my $field = $AUTOLOAD;
+# $field =~ s/.*://;
+# if ( defined($_[1]) ) {
+# $_[0]->setfield($field, $_[1]);
+# } else {
+# $_[0]->getfield($field);
+# }
+#}
+
=item hash
Returns a list of the column/value pairs, usually for assigning to a new hash.
$h_sth->execute or return $h_sth->errstr if $h_sth;
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
- #no need to needlessly destoy the data either
+ #no need to needlessly destoy the data either (causes problems actually)
#undef $self; #no need to keep object!
'';
=item ut_text COLUMN
Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / =
May not be null. If there is an error, returns the error, otherwise returns
false.
sub ut_text {
my($self,$field)=@_;
- $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
- or return "Illegal or empty (text) $field: ". $self->getfield($field);
+ #warn "msgcat ". \&msgcat. "\n";
+ #warn "notexist ". \¬exist. "\n";
+ #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
+ $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/
+ or return gettext('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: ". $self->getfield($field);
+ $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+ or return gettext('illegal_text'). " $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
} elsif ( $country eq 'US' || $country eq 'CA' ) {
$phonen =~ s/\D//g;
$phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
- or return "Illegal (phone) $field: ". $self->getfield($field);
+ or return gettext('illegal_phone'). " $field: ". $self->getfield($field);
$phonen = "$1-$2-$3";
$phonen .= " x$4" if $4;
$self->setfield($field,$phonen);
sub ut_domain {
my( $self, $field ) = @_;
#$self->getfield($field) =~/^(\w+\.)*\w+$/
- $self->getfield($field) =~/^([\w\-]+\.)*\w+$/
+ $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
or return "Illegal (domain) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
sub ut_name {
my( $self, $field ) = @_;
$self->getfield($field) =~ /^([\w \,\.\-\']+)$/
- or return "Illegal (name) $field: ". $self->getfield($field);
+ or return gettext('illegal_name'). " $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
}
my( $self, $field, $country ) = @_;
if ( $country eq 'US' ) {
$self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
- or return "Illegal (zip) $field for country $country: ".
+ or return gettext('illegal_zip'). " $field for country $country: ".
$self->getfield($field);
$self->setfield($field,$1);
} else {
$self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
- or return "Illegal (zip) $field: ". $self->getfield($field);
+ or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
$self->setfield($field,$1);
}
'';
sub reload_dbdef {
my $file = shift || $dbdef_file;
- $dbdef = load DBIx::DBSchema $file
- or die "can't load database schema from $file";
+ $dbdef = exists $dbdef_cache{$file}
+ ? $dbdef_cache{$file}
+ : $dbdef_cache{$file} = DBIx::DBSchema->load( $file )
+ or die "can't load database schema from $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 {