use strict;
use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
$conf $me
- %virtual_fields_cache $nowarn_identical );
+ %virtual_fields_cache $nowarn_identical $no_update_diff );
use Exporter;
use Carp qw(carp cluck croak confess);
use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.25;
+use DBIx::DBSchema 0.33;
use FS::UID qw(dbh getotaker datasrc driver_name);
use FS::CurrentUser;
use FS::Schema qw(dbdef);
@ISA = qw(Exporter);
#export dbdef for now... everything else expects to find it here
-@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
+@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch str2time_sql);
$DEBUG = 0;
$me = '[FS::Record]';
$nowarn_identical = 0;
+$no_update_diff = 0;
my $rsa_module;
my $rsa_loaded;
#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,
}
);
=cut
sub qsearch {
- my($stable, $record, $select, $extra_sql, $cache, $addl_from );
+ my($stable, $record, $select, $extra_sql, $order_by, $cache, $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'} || '';
} else {
($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
$select ||= '*';
$statement .= " $addl_from" if $addl_from;
if ( @real_fields or @virtual_fields ) {
$statement .= ' WHERE '. join(' AND ',
- ( map {
-
- my $op = '=';
- my $column = $_;
- if ( ref($record->{$_}) ) {
- $op = $record->{$_}{'op'} if $record->{$_}{'op'};
- #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
- if ( uc($op) eq 'ILIKE' ) {
- $op = 'LIKE';
- $record->{$_}{'value'} = lc($record->{$_}{'value'});
- $column = "LOWER($_)";
- }
- $record->{$_} = $record->{$_}{'value'}
- }
-
- if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
- if ( $op eq '=' ) {
- if ( driver_name eq 'Pg' ) {
- my $type = dbdef->table($table)->column($column)->type;
- if ( $type =~ /(int|(big)?serial)/i ) {
- qq-( $column IS NULL )-;
- } else {
- qq-( $column IS NULL OR $column = '' )-;
- }
- } else {
- qq-( $column IS NULL OR $column = "" )-;
- }
- } elsif ( $op eq '!=' ) {
- if ( driver_name eq 'Pg' ) {
- my $type = dbdef->table($table)->column($column)->type;
- if ( $type =~ /(int|(big)?serial)/i ) {
- qq-( $column IS NOT NULL )-;
- } else {
- qq-( $column IS NOT NULL AND $column != '' )-;
- }
- } else {
- qq-( $column IS NOT NULL AND $column != "" )-;
- }
- } else {
- if ( driver_name eq 'Pg' ) {
- qq-( $column $op '' )-;
- } else {
- qq-( $column $op "" )-;
- }
- }
- } else {
- "$column $op ?";
- }
- } @real_fields ),
- ( map {
- my $op = '=';
- my $column = $_;
- if ( ref($record->{$_}) ) {
- $op = $record->{$_}{'op'} if $record->{$_}{'op'};
- if ( uc($op) eq 'ILIKE' ) {
- $op = 'LIKE';
- $record->{$_}{'value'} = lc($record->{$_}{'value'});
- $column = "LOWER($_)";
- }
- $record->{$_} = $record->{$_}{'value'};
- }
-
- # ... EXISTS ( SELECT name, value FROM part_virtual_field
- # JOIN virtual_field
- # ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
- # WHERE recnum = svc_acct.svcnum
- # AND (name, value) = ('egad', 'brain') )
-
- my $value = $record->{$_};
-
- my $subq;
-
- $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
- "( SELECT part_virtual_field.name, virtual_field.value ".
- "FROM part_virtual_field JOIN virtual_field ".
- "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
- "WHERE virtual_field.recnum = ${table}.${pkey} ".
- "AND part_virtual_field.name = '${column}'".
- ($value ?
- " AND virtual_field.value ${op} '${value}'"
- : "") . ")";
- $subq;
-
- } @virtual_fields ) );
-
+ get_real_fields($table, $record, \@real_fields) ,
+ get_virtual_fields($table, $pkey, $record, \@virtual_fields),
+ );
}
$statement .= " $extra_sql" if defined($extra_sql);
+ $statement .= " $order_by" if defined($order_by);
- warn "[debug]$me $statement\n" if $DEBUG > 1;
+ warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
my $sth = $dbh->prepare($statement)
or croak "$dbh->errstr doing $statement";
return @return;
}
+## makes this easier to read
+
+sub get_virtual_fields {
+ my $table = shift;
+ my $pkey = shift;
+ my $record = shift;
+ my $virtual_fields = shift;
+
+ return
+ ( map {
+ my $op = '=';
+ my $column = $_;
+ if ( ref($record->{$_}) ) {
+ $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+ if ( uc($op) eq 'ILIKE' ) {
+ $op = 'LIKE';
+ $record->{$_}{'value'} = lc($record->{$_}{'value'});
+ $column = "LOWER($_)";
+ }
+ $record->{$_} = $record->{$_}{'value'};
+ }
+
+ # ... EXISTS ( SELECT name, value FROM part_virtual_field
+ # JOIN virtual_field
+ # ON part_virtual_field.vfieldpart = virtual_field.vfieldpart
+ # WHERE recnum = svc_acct.svcnum
+ # AND (name, value) = ('egad', 'brain') )
+
+ my $value = $record->{$_};
+
+ my $subq;
+
+ $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') .
+ "( SELECT part_virtual_field.name, virtual_field.value ".
+ "FROM part_virtual_field JOIN virtual_field ".
+ "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ".
+ "WHERE virtual_field.recnum = ${table}.${pkey} ".
+ "AND part_virtual_field.name = '${column}'".
+ ($value ?
+ " AND virtual_field.value ${op} '${value}'"
+ : "") . ")";
+ $subq;
+
+ } @{ $virtual_fields } ) ;
+}
+
+sub get_real_fields {
+ my $table = shift;
+ my $record = shift;
+ my $real_fields = shift;
+
+ ## this huge map was previously inline, just broke it out to help read the qsearch method, should be optimized for readability
+ return (
+ map {
+
+ my $op = '=';
+ my $column = $_;
+ if ( ref($record->{$_}) ) {
+ $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+ #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg';
+ if ( uc($op) eq 'ILIKE' ) {
+ $op = 'LIKE';
+ $record->{$_}{'value'} = lc($record->{$_}{'value'});
+ $column = "LOWER($_)";
+ }
+ $record->{$_} = $record->{$_}{'value'}
+ }
+
+ if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
+ if ( $op eq '=' ) {
+ if ( driver_name eq 'Pg' ) {
+ my $type = dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|(big)?serial)/i ) {
+ qq-( $column IS NULL )-;
+ } else {
+ qq-( $column IS NULL OR $column = '' )-;
+ }
+ } else {
+ qq-( $column IS NULL OR $column = "" )-;
+ }
+ } elsif ( $op eq '!=' ) {
+ if ( driver_name eq 'Pg' ) {
+ my $type = dbdef->table($table)->column($column)->type;
+ if ( $type =~ /(int|(big)?serial)/i ) {
+ qq-( $column IS NOT NULL )-;
+ } else {
+ qq-( $column IS NOT NULL AND $column != '' )-;
+ }
+ } else {
+ qq-( $column IS NOT NULL AND $column != "" )-;
+ }
+ } else {
+ if ( driver_name eq 'Pg' ) {
+ qq-( $column $op '' )-;
+ } else {
+ qq-( $column $op "" )-;
+ }
+ }
+ } else {
+ "$column $op ?";
+ }
+ } @{ $real_fields } );
+}
+
=item by_key PRIMARY_KEY_VALUE
This is a class method that returns the record with the given primary key
#single-field unique keys are given a value if false
#(like MySQL's AUTO_INCREMENT or Pg SERIAL)
- foreach ( $self->dbdef_table->unique->singles ) {
+ foreach ( $self->dbdef_table->unique_singles) {
$self->unique($_) unless $self->getfield($_);
}
# Encrypt before the database
+ my $conf = new FS::Conf;
if ($conf->exists('encryption') && defined(eval '@FS::'. $table . '::encrypted_fields')) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
$self->{'saved'} = $self->getfield($field);
my %diff = map { ($new->getfield($_) ne $old->getfield($_))
? ($_, $new->getfield($_)) : () } $old->fields;
- unless ( keys(%diff) ) {
+ unless (keys(%diff) || $no_update_diff ) {
carp "[warning]$me $new -> replace $old: records identical"
unless $nowarn_identical;
return '';
# 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...
+ my $conf = new FS::Conf;
if ($conf->exists('encryption') ) {
@fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields;
}
return (real_fields($table), $something->virtual_fields());
}
-=back
-
=item pvf FIELD_NAME
Returns the FS::part_virtual_field object corresponding to a field in the
''
}
-=head1 SUBROUTINES
-
-=over 4
-
-=item real_fields [ TABLE ]
-
-Returns a list of the real columns in the specified table. Called only by
-fields() and other subroutines elsewhere in FS::Record.
-
-=cut
-
-sub real_fields {
- my $table = shift;
-
- my($table_obj) = dbdef->table($table);
- confess "Unknown table $table" unless $table_obj;
- $table_obj->columns;
-}
-
-=item _quote VALUE, TABLE, COLUMN
-
-This is an internal function used to construct SQL statements. It returns
-VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
-type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
-
-=cut
-
-sub _quote {
- my($value, $table, $column) = @_;
- my $column_obj = dbdef->table($table)->column($column);
- my $column_type = $column_obj->type;
- my $nullable = $column_obj->null;
-
- warn " $table.$column: $value ($column_type".
- ( $nullable ? ' NULL' : ' NOT NULL' ).
- ")\n" if $DEBUG > 2;
-
- if ( $value eq '' && $nullable ) {
- 'NULL'
- } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
- cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
- "using 0 instead";
- 0;
- } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
- ! $column_type =~ /(char|binary|text)$/i ) {
- $value;
- } else {
- dbh->quote($value);
- }
-}
-
=item vfieldpart_hashref TABLE
Returns a hashref of virtual field names and vfieldparts applicable to the given
}
-
-=item hfields TABLE
-
-This is deprecated. Don't use it.
-
-It returns a hash-type list with the fields of this record's table set true.
-
-=cut
-
-sub hfields {
- carp "warning: hfields is deprecated";
- my($table)=@_;
- my(%hash);
- foreach (fields($table)) {
- $hash{$_}=1;
- }
- \%hash;
-}
-
-sub _dump {
- my($self)=@_;
- join("\n", map {
- "$_: ". $self->getfield($_). "|"
- } (fields($self->table)) );
-}
-
=item encrypt($value)
Encrypts the credit card using a combination of PK to encrypt and uuencode to armour.
=cut
-
sub encrypt {
my ($self, $value) = @_;
my $encrypted;
$rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
my $conf = new FS::Conf;
- if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
+ if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') {
$rsa_module = $conf->config('encryptionmodule');
}
$rsa_loaded++;
}
# Initialize Encryption
- if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
+ if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') {
my $public_key = join("\n",$conf->config('encryptionpublickey'));
$rsa_encrypt = $rsa_module->new_public_key($public_key);
}
# Intitalize Decryption
- if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
+ if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') {
my $private_key = join("\n",$conf->config('encryptionprivatekey'));
$rsa_decrypt = $rsa_module->new_private_key($private_key);
}
}
+=item h_search ACTION
+
+Given an ACTION, either "insert", or "delete", returns the appropriate history
+record corresponding to this record, if any.
+
+=cut
+
+sub h_search {
+ my( $self, $action ) = @_;
+
+ my $table = $self->table;
+ $table =~ s/^h_//;
+
+ my $primary_key = dbdef->table($table)->primary_key;
+
+ qsearchs({
+ 'table' => "h_$table",
+ 'hashref' => { $primary_key => $self->$primary_key(),
+ 'history_action' => $action,
+ },
+ });
+
+}
+
+=item h_date ACTION
+
+Given an ACTION, either "insert", or "delete", returns the timestamp of the
+appropriate history record corresponding to this record, if any.
+
+=cut
+
+sub h_date {
+ my($self, $action) = @_;
+ my $h = $self->h_search($action);
+ $h ? $h->history_date : '';
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item real_fields [ TABLE ]
+
+Returns a list of the real columns in the specified table. Called only by
+fields() and other subroutines elsewhere in FS::Record.
+
+=cut
+
+sub real_fields {
+ my $table = shift;
+
+ my($table_obj) = dbdef->table($table);
+ confess "Unknown table $table" unless $table_obj;
+ $table_obj->columns;
+}
+
+=item _quote VALUE, TABLE, COLUMN
+
+This is an internal function used to construct SQL statements. It returns
+VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
+type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
+
+=cut
+
+sub _quote {
+ my($value, $table, $column) = @_;
+ my $column_obj = dbdef->table($table)->column($column);
+ my $column_type = $column_obj->type;
+ my $nullable = $column_obj->null;
+
+ warn " $table.$column: $value ($column_type".
+ ( $nullable ? ' NULL' : ' NOT NULL' ).
+ ")\n" if $DEBUG > 2;
+
+ if ( $value eq '' && $nullable ) {
+ 'NULL'
+ } elsif ( $value eq '' && $column_type =~ /^(int|numeric)/ ) {
+ cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
+ "using 0 instead";
+ 0;
+ } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
+ ! $column_type =~ /(char|binary|text)$/i ) {
+ $value;
+ } else {
+ dbh->quote($value);
+ }
+}
+
+=item hfields TABLE
+
+This is deprecated. Don't use it.
+
+It returns a hash-type list with the fields of this record's table set true.
+
+=cut
+
+sub hfields {
+ carp "warning: hfields is deprecated";
+ my($table)=@_;
+ my(%hash);
+ foreach (fields($table)) {
+ $hash{$_}=1;
+ }
+ \%hash;
+}
+
+sub _dump {
+ my($self)=@_;
+ join("\n", map {
+ "$_: ". $self->getfield($_). "|"
+ } (fields($self->table)) );
+}
+
sub DESTROY { return; }
#sub DESTROY {
# return ! eval { join('',@_), kill 0; 1; };
# }
+=item str2time_sql [ DRIVER_NAME ]
+
+Returns a function to convert to unix time based on database type, such as
+"EXTRACT( EPOCH FROM" for Pg or "UNIX_TIMESTAMP(" for mysql. You are
+responsible for the closing parenthesis yourself. Don't let it down. It's a
+sensitive parenthesis.
+
+You can pass an optional driver name such as "Pg", "mysql" or
+$dbh->{Driver}->{Name} to return a function for that database instead of
+the current database.
+
+=cut
+
+sub str2time_sql {
+ my $driver = shift || driver_name;
+
+ return 'UNIX_TIMESTAMP(' if $driver =~ /^mysql/i;
+ return 'EXTRACT( EPOCH FROM ' if $driver =~ /^Pg/i;
+
+ warn "warning: unknown database type $driver; guessing how to convert ".
+ "dates to UNIX timestamps";
+ return 'EXTRACT(EPOCH FROM ';
+
+}
+
=back
=head1 BUGS
projects / freeside.git / blobdiff