use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
$conf $conf_encryption $me
%virtual_fields_cache
- $nowarn_identical $no_update_diff $no_check_foreign
+ $nowarn_identical $nowarn_classload
+ $no_update_diff $no_check_foreign
);
use Exporter;
use Carp qw(carp cluck croak confess);
$me = '[FS::Record]';
$nowarn_identical = 0;
+$nowarn_classload = 0;
$no_update_diff = 0;
$no_check_foreign = 0;
$conf = FS::Conf->new;
$conf_encryption = $conf->exists('encryption');
$File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
+ if ( driver_name eq 'Pg' ) {
+ eval "use DBD::Pg ':pg_types'";
+ die $@ if $@;
+ } else {
+ eval "sub PG_BYTEA { die 'guru meditation #9: calling PG_BYTEA when not running Pg?'; }";
+ }
} );
-
=head1 NAME
FS::Record - Database record objects
unless ( defined ( $self->table ) ) {
$self->{'Table'} = shift;
- carp "warning: FS::Record::new called with table name ". $self->{'Table'};
+ carp "warning: FS::Record::new called with table name ". $self->{'Table'}
+ unless $nowarn_classload;
}
$self->{'Hash'} = shift;
The preferred usage is to pass a hash reference of named parameters:
- my @records = qsearch( {
- 'table' => 'table_name',
- 'hashref' => { 'field' => 'value'
- 'field' => { 'op' => '<',
- 'value' => '420',
- },
- },
-
- #these are optional...
- 'select' => '*',
- 'extra_sql' => 'AND field ',
- 'order_by' => 'ORDER BY something',
- #'cache_obj' => '', #optional
- 'addl_from' => 'LEFT JOIN othtable USING ( field )',
- 'debug' => 1,
- }
- );
+ @records = qsearch( {
+ 'table' => 'table_name',
+ 'hashref' => { 'field' => 'value'
+ 'field' => { 'op' => '<',
+ 'value' => '420',
+ },
+ },
+
+ #these are optional...
+ 'select' => '*',
+ 'extra_sql' => 'AND field = ? AND intfield = ?',
+ 'extra_param' => [ 'value', [ 5, 'int' ] ],
+ 'order_by' => 'ORDER BY something',
+ #'cache_obj' => '', #optional
+ 'addl_from' => 'LEFT JOIN othtable USING ( field )',
+ 'debug' => 1,
+ }
+ );
Much code still uses old-style positional parameters, this is also probably
fine in the common case where there are only two parameters:
my %TYPE = (); #for debugging
+sub _bind_type {
+ my($type, $value) = @_;
+
+ my $bind_type = { TYPE => SQL_VARCHAR };
+
+ if ( $type =~ /(big)?(int|serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
+
+ $bind_type = { TYPE => SQL_INTEGER };
+
+ } elsif ( $type =~ /^bytea$/i || $type =~ /(blob|varbinary)/i ) {
+
+ if ( driver_name eq 'Pg' ) {
+ no strict 'subs';
+ $bind_type = { pg_type => PG_BYTEA };
+ #} else {
+ # $bind_type = ? #SQL_VARCHAR could be fine?
+ }
+
+ #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6 with SQL_FLOAT
+ #fixed by DBD::Pg 2.11.8
+ #can change back to SQL_FLOAT in early-mid 2010, once everyone's upgraded
+ #(make a Tron test first)
+ } elsif ( _is_fs_float( $type, $value ) ) {
+
+ $bind_type = { TYPE => SQL_DECIMAL };
+
+ }
+
+ $bind_type;
+
+}
+
sub _is_fs_float {
- my ($type, $value) = @_;
+ my($type, $value) = @_;
if ( ( $type =~ /(numeric)/i && $value =~ /^[+-]?\d+(\.\d+)?$/ ) ||
( $type =~ /(real|float4)/i && $value =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/)
) {
}
sub qsearch {
- my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from );
+ my($stable, $record, $cache );
+ my( $select, $extra_sql, $extra_param, $order_by, $addl_from );
my $debug = '';
if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
my $opt = shift;
- $stable = $opt->{'table'} or die "table name is required";
- $record = $opt->{'hashref'} || {};
- $select = $opt->{'select'} || '*';
- $extra_sql = $opt->{'extra_sql'} || '';
- $order_by = $opt->{'order_by'} || '';
- $cache = $opt->{'cache_obj'} || '';
- $addl_from = $opt->{'addl_from'} || '';
- $debug = $opt->{'debug'} || '';
+ $stable = $opt->{'table'} or die "table name is required";
+ $record = $opt->{'hashref'} || {};
+ $select = $opt->{'select'} || '*';
+ $extra_sql = $opt->{'extra_sql'} || '';
+ $extra_param = $opt->{'extra_param'} || [];
+ $order_by = $opt->{'order_by'} || '';
+ $cache = $opt->{'cache_obj'} || '';
+ $addl_from = $opt->{'addl_from'} || '';
+ $debug = $opt->{'debug'} || '';
} else {
($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
$select ||= '*';
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
@virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields;
} else {
- cluck "warning: FS::$table not loaded; virtual fields not searchable";
+ cluck "warning: FS::$table not loaded; virtual fields not searchable"
+ unless $nowarn_classload;
@virtual_fields = ();
}
$value = $value->{'value'} if ref($value);
my $type = dbdef->table($table)->column($field)->type;
- my $TYPE = SQL_VARCHAR;
- if ( $type =~ /(int|(big)?serial)/i && $value =~ /^\d+(\.\d+)?$/ ) {
- $TYPE = SQL_INTEGER;
+ my $bind_type = _bind_type($type, $value);
- #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6 with SQL_FLOAT
- #fixed by DBD::Pg 2.11.8
- #can change back to SQL_FLOAT in early-mid 2010, once everyone's upgraded
- } elsif ( _is_fs_float( $type, $value ) ) {
- $TYPE = SQL_DECIMAL;
- }
-
- if ( $DEBUG > 2 ) {
- no strict 'refs';
- %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} }
- unless keys %TYPE;
- warn " bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n";
- }
+ #if ( $DEBUG > 2 ) {
+ # no strict 'refs';
+ # %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} }
+ # unless keys %TYPE;
+ # warn " bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n";
+ #}
#if this needs to be re-enabled, it needs to use a custom op like
#"APPROX=" or something (better name?, not '=', to avoid affecting other
# $sth->bind_param($bind++, $value*1.00001, { TYPE => $TYPE } );
# $sth->bind_param($bind++, $value*.99999, { TYPE => $TYPE } );
#} else {
- $sth->bind_param($bind++, $value, { TYPE => $TYPE } );
+ $sth->bind_param($bind++, $value, $bind_type );
#}
}
+ foreach my $param ( @$extra_param ) {
+ my $bind_type = { TYPE => SQL_VARCHAR };
+ my $value = $param;
+ if ( ref($param) ) {
+ $value = $param->[0];
+ my $type = $param->[1];
+ $bind_type = _bind_type($type, $value);
+ }
+ $sth->bind_param($bind++, $value, $bind_type );
+ }
+
# $sth->execute( map $record->{$_},
# grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
# ) or croak "Error executing \"$statement\": ". $sth->errstr;
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
@virtual_fields = "FS::$table"->virtual_fields;
} else {
- cluck "warning: FS::$table not loaded; virtual fields not returned either";
+ cluck "warning: FS::$table not loaded; virtual fields not returned either"
+ unless $nowarn_classload;
@virtual_fields = ();
}
}
}
} else {
- cluck "warning: FS::$table not loaded; returning FS::Record objects";
+ cluck "warning: FS::$table not loaded; returning FS::Record objects"
+ unless $nowarn_classload;
@return = map {
FS::Record->new( $table, { %{$_} } );
} values(%result);
my $record = $class->new( \%hash );
+ my $param = {};
while ( scalar(@later) ) {
my $sub = shift @later;
my $data = shift @later;
- &{$sub}($record, $data, $conf); # $record->&{$sub}($data, $conf);
+ &{$sub}($record, $data, $conf, $param); # $record->&{$sub}($data, $conf);
+ last if exists( $param->{skiprow} );
}
+ next if exists( $param->{skiprow} );
my $error = $record->insert;
$time ||= time;
+ my %nohistory = map { $_=>1 } $self->nohistory_fields;
+
my @fields =
- grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
+ grep { defined($self->get($_)) && $self->get($_) ne "" && ! $nohistory{$_} }
real_fields($self->table);
;
- # If we're encrypting then don't ever store the payinfo or CVV2 in the history....
- # You can see if it changed by the paymask...
- if ($conf && $conf->exists('encryption') ) {
- @fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields;
+ # If we're encrypting then don't store the payinfo in the history
+ if ( $conf && $conf->exists('encryption') ) {
+ @fields = grep { $_ ne 'payinfo' } @fields;
}
+
my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
"INSERT INTO h_". $self->table. " ( ".
'';
}
+=item ut_moneyn COLUMN
+
+Check/untaint monetary numbers. May be negative. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_moneyn {
+ my($self,$field)=@_;
+ if ($self->getfield($field) eq '') {
+ $self->setfield($field, '');
+ return '';
+ }
+ $self->ut_money($field);
+}
+
=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.
#warn "notexist ". \¬exist. "\n";
#warn "AUTOLOAD ". \&AUTOLOAD. "\n";
$self->getfield($field)
- =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]+)$/
+ =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]\<\>]+)$/
or return gettext('illegal_or_empty_text'). " $field: ".
$self->getfield($field);
$self->setfield($field,$1);
my( $self, $field, $choices ) = @_;
foreach my $choice ( @$choices ) {
if ( $self->getfield($field) eq $choice ) {
- $self->setfield($choice);
+ $self->setfield($field, $choice);
return '';
}
}
")\n" if $DEBUG > 2;
if ( $value eq '' && $nullable ) {
- 'NULL'
+ 'NULL';
} elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
"using 0 instead";
} elsif ( $value =~ /^\d+(\.\d+)?$/ &&
! $column_type =~ /(char|binary|text)$/i ) {
$value;
+ } elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i )
+ && 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) ) . "'");
} else {
dbh->quote($value);
}