use base qw( Exporter );
use strict;
+use charnames ':full';
use vars qw( $AUTOLOAD
- %virtual_fields_cache %fk_method_cache
+ %virtual_fields_cache %fk_method_cache $fk_table_cache
$money_char $lat_lower $lon_upper
+ $use_placeholders
);
use Carp qw(carp cluck croak confess);
use Scalar::Util qw( blessed );
use Locale::Country;
use Locale::Currency;
use NetAddr::IP; # for validation
+use Crypt::OpenSSL::RSA;
use FS::UID qw(dbh datasrc driver_name);
use FS::CurrentUser;
use FS::Schema qw(dbdef);
dbh fields hfields qsearch qsearchs dbdef jsearch
str2time_sql str2time_sql_closing regexp_sql not_regexp_sql
concat_sql group_concat_sql
- midnight_sql
+ midnight_sql fk_methods_init
);
our $DEBUG = 0;
our $me = '[FS::Record]';
+$use_placeholders = 0;
+
our $nowarn_identical = 0;
our $nowarn_classload = 0;
our $no_update_diff = 0;
our $no_check_foreign = 1; #well, not inefficiently in perl by default anymore
-my $rsa_module;
-my $rsa_loaded;
my $rsa_encrypt;
my $rsa_decrypt;
eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
}
- foreach my $table ( dbdef->tables ) {
- $fk_method_cache{$table} = fk_methods($table);
- }
+ #fk_methods_init();
} );
$self->{'modified'} = 0;
+ $self->_simplecache($self->{'Hash'}) if $self->can('_simplecache');
$self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_;
$self;
exists($self->{Hash}->{$field});
}
-=item AUTLOADED METHODS
+=item AUTOLOADED METHODS
$record->column is a synonym for $record->get('column');
confess "errant AUTOLOAD $field for $self (arg $value)"
unless blessed($self) && $self->can('setfield');
- #$fk_method_cache{$self->table} ||= fk_methods($self->table);
- if ( exists($fk_method_cache{$self->table}->{$field}) ) {
+ if ( my $fk_info = get_fk_method($self->table, $field) ) {
- my $fk_info = $fk_method_cache{$self->table}->{$field};
my $method = $fk_info->{method} || 'qsearchs';
my $table = $fk_info->{table} || $field;
my $column = $fk_info->{column};
# }
#}
+# get_fk_method(TABLE, FIELD)
+# Internal subroutine for fetching the foreign key descriptor for TABLE.FIELD
+# if there is one. If not, returns undef.
+# This will initialize fk_method_cache if it hasn't happened yet. It is the
+# _only_ allowed way to access the contents of %fk_method_cache.
+
+# if we wanted to be even more efficient we'd create the fk methods in the
+# symbol table instead of relying on AUTOLOAD every time
+
+sub get_fk_method {
+ my ($table, $field) = @_;
+
+ fk_methods_init() unless exists($fk_method_cache{$table});
+
+ if ( exists($fk_method_cache{$table}) and
+ exists($fk_method_cache{$table}{$field}) ) {
+ return $fk_method_cache{$table}{$field};
+ } else {
+ return undef;
+ }
+
+}
+
+sub fk_methods_init {
+ warn "[fk_methods_init]\n" if $DEBUG;
+ foreach my $table ( dbdef->tables ) {
+ $fk_method_cache{$table} = fk_methods($table);
+ }
+}
+
sub fk_methods {
my $table = shift;
# (alas. why we're cached. still, might this loop better be done once at
# schema load time insetad of every time we AUTOLOAD a method on a new
# class?)
- foreach my $f_table ( dbdef->tables ) {
- foreach my $fk (dbdef->table($f_table)->foreign_keys) {
-
- next unless $fk->table eq $table;
-
+ if (! defined $fk_table_cache) {
+ foreach my $f_table ( dbdef->tables ) {
+ foreach my $fk (dbdef->table($f_table)->foreign_keys) {
+ push @{$fk_table_cache->{$fk->table}},[$f_table,$fk];
+ }
+ }
+ }
+ foreach my $fks (@{$fk_table_cache->{$table}}) {
+ my ($f_table,$fk) = @$fks;
my $method = '';
if ( scalar( @{$fk->columns} ) == 1 ) {
if ( ! defined($fk->references)
}
}
-
- }
-
}
\%hash;
my $table = $self->table;
# Encrypt before the database
- if ( defined(eval '@FS::'. $table . '::encrypted_fields')
- && scalar( eval '@FS::'. $table . '::encrypted_fields')
+ if ( scalar( eval '@FS::'. $table . '::encrypted_fields')
&& $conf_encryption
) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
real_fields($table)
;
- my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
- #eslaf
my $statement = "INSERT INTO $table ";
- if ( @real_fields ) {
- $statement .=
- "( ".
- join( ', ', @real_fields ).
- ") VALUES (".
- join( ', ', @values ).
- ")"
- ;
- } else {
+ my @bind_values = ();
+
+ if ( ! @real_fields ) {
+
$statement .= 'DEFAULT VALUES';
+
+ } else {
+
+ if ( $use_placeholders ) {
+
+ @bind_values = map $self->getfield($_), @real_fields;
+
+ $statement .=
+ "( ".
+ join( ', ', @real_fields ).
+ ") VALUES (".
+ join( ', ', map '?', @real_fields ). # @bind_values ).
+ ")"
+ ;
+
+ } else {
+
+ my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields;
+
+ $statement .=
+ "( ".
+ join( ', ', @real_fields ).
+ ") VALUES (".
+ join( ', ', @values ).
+ ")"
+ ;
+
+ }
+
}
+
warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = dbh->prepare($statement) or return dbh->errstr;
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- $sth->execute or return $sth->errstr;
+ $sth->execute(@bind_values) or return $sth->errstr;
# get inserted id from the database, if applicable & needed
if ( $db_seq && ! $self->getfield($primary_key) ) {
# Encrypt for replace
my $saved = {};
- if ( $conf_encryption
- && defined(eval '@FS::'. $new->table . '::encrypted_fields')
- && scalar( eval '@FS::'. $new->table . '::encrypted_fields')
+ if ( scalar( eval '@FS::'. $new->table . '::encrypted_fields')
+ && $conf_encryption
) {
foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
next if $field eq 'payinfo'
=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.
# \p{Word} = alphanumerics, marks (diacritics), and connectors
# see perldoc perluniprops
$self->getfield($field)
- =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>$money_char]+)$/
+ =~ /^([\p{Word} \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>\~$money_char]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
my $coord = $self->getfield($field);
my $neg = $coord =~ s/^(-)//;
+ # ignore degree symbol at the end,
+ # but not otherwise supporting degree/minutes/seconds symbols
+ $coord =~ s/\N{DEGREE SIGN}\s*$//;
+
my ($d, $m, $s) = (0, 0, 0);
if (
sub ut_name {
my( $self, $field ) = @_;
-# warn "ut_name allowed alphanumerics: +(sort grep /\w/, map { chr() } 0..255), "\n";
$self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
my $name = $1;
$self->getfield($field);
$self->setfield($field, "$1 $2");
+ } elsif ( $country eq 'AU' ) {
+
+ $self->getfield($field) =~ /^\s*(\d{4})\s*$/
+ or return gettext('illegal_zip'). " $field for country $country: ".
+ $self->getfield($field);
+ $self->setfield($field, $1);
+
} else {
if ( $self->getfield($field) =~ /^\s*$/
}
+=item trim_whitespace FIELD[, FIELD ... ]
+
+Strip leading and trailing spaces from the value in the named FIELD(s).
+
+=cut
+
+sub trim_whitespace {
+ my $self = shift;
+ foreach my $field (@_) {
+ my $value = $self->get($field);
+ $value =~ s/^\s+//;
+ $value =~ s/\s+$//;
+ $self->set($field, $value);
+ }
+}
+
=item fields [ TABLE ]
This is a wrapper for real_fields. Code that called
}
sub loadRSA {
- my $self = shift;
- #Initialize the Module
- $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
+ my $self = shift;
- if ($conf_encryptionmodule && $conf_encryptionmodule ne '') {
- $rsa_module = $conf_encryptionmodule;
- }
+ my $rsa_module = $conf_encryptionmodule || 'Crypt::OpenSSL::RSA';
- if (!$rsa_loaded) {
- eval ("require $rsa_module"); # No need to import the namespace
- $rsa_loaded++;
- }
- # Initialize Encryption
- if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
- $rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey);
- }
+ # Initialize Encryption
+ if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
+ $rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey);
+ }
- # Intitalize Decryption
- if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
- $rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey);
- }
+ # Intitalize Decryption
+ if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
+ $rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey);
+ }
}
=item h_search ACTION
&& driver_name eq 'Pg'
)
{
- no strict 'subs';
-# dbh->quote($value, { pg_type => PG_BYTEA() }); # doesn't work right
- # Pg binary string quoting: convert each character to 3-digit octal prefixed with \\,
- # single-quote the whole mess, and put an "E" in front.
- return ("E'" . join('', map { sprintf('\\\\%03o', ord($_)) } split(//, $value) ) . "'");
+ dbh->quote($value, { pg_type => PG_BYTEA() });
} else {
dbh->quote($value);
}
projects / freeside.git / blobdiff