package FS::Record;
use strict;
-use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me %dbdef_cache %virtual_fields_cache );
-use subs qw(reload_dbdef);
+use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+ $me %virtual_fields_cache $nowarn_identical );
use Exporter;
use Carp qw(carp cluck croak confess);
use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.23;
+use DBIx::DBSchema 0.25;
use FS::UID qw(dbh getotaker datasrc driver_name);
+use FS::Schema qw(dbdef);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
use FS::Conf;
use Tie::IxHash;
@ISA = qw(Exporter);
+
+#export dbdef for now... everything else expects to find it here
@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
$DEBUG = 0;
$me = '[FS::Record]';
+$nowarn_identical = 0;
+
my $conf;
my $rsa_module;
my $rsa_loaded;
my $rsa_encrypt;
my $rsa_decrypt;
-#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::Record'} = sub {
+FS::UID->install_callback( sub {
$conf = new FS::Conf;
$File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
- $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
- &reload_dbdef unless $setup_hack; #$setup_hack needed now?
-};
+} );
=head1 NAME
=head1 SYNOPSIS
use FS::Record;
- use FS::Record qw(dbh fields qsearch qsearchs dbdef);
+ use FS::Record qw(dbh fields qsearch qsearchs);
$record = new FS::Record 'table', \%hash;
$record = new FS::Record 'table', { 'column' => 'value', ... };
$error = $record->ut_anything('column');
$error = $record->ut_name('column');
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
-
$quoted_value = _quote($value,'table','field');
#deprecated
}
}
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
+=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
Searches the database for all records matching (at least) the key/value pairs
in HASHREF. Returns all the records found as `FS::TABLE' objects if that
module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
objects.
+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 ',
+ #'cache_obj' => '', #optional
+ 'addl_from' => 'LEFT JOIN othtable USING ( field )',
+ }
+ );
+
+Much code still uses old-style positional parameters, this is also probably
+fine in the common case where there are only two parameters:
+
+ my @records = qsearch( 'table', { 'field' => 'value' } );
+
###oops, argh, FS::Record::new only lets us create database fields.
#Normal behaviour if SELECT is not specified is `*', as in
#C<SELECT * FROM table WHERE ...>. However, there is an experimental new
=cut
sub qsearch {
- my($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+ my($stable, $record, $select, $extra_sql, $cache, $addl_from );
+ 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'} || '';
+ $cache = $opt->{'cache_obj'} || '';
+ $addl_from = $opt->{'addl_from'} || '';
+ } else {
+ ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
+ $select ||= '*';
+ }
+
#$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
#for jsearch
$stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
$stable = $1;
- $select ||= '*';
my $dbh = dbh;
my $table = $cache ? $cache->table : $stable;
- my $dbdef_table = $dbdef->table($table)
+ my $dbdef_table = dbdef->table($table)
or die "No schema for table $table found - ".
"do you need to create it or run dbdef-create?";
my $pkey = $dbdef_table->primary_key;
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( $op eq '=' ) {
if ( driver_name eq 'Pg' ) {
- my $type = $dbdef->table($table)->column($column)->type;
+ my $type = dbdef->table($table)->column($column)->type;
if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NULL )-;
} else {
}
} elsif ( $op eq '!=' ) {
if ( driver_name eq 'Pg' ) {
- my $type = $dbdef->table($table)->column($column)->type;
+ my $type = dbdef->table($table)->column($column)->type;
if ( $type =~ /(int|serial)/i ) {
qq-( $column IS NOT NULL )-;
} else {
grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
) {
if ( $record->{$field} =~ /^\d+(\.\d+)?$/
- && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i
+ && dbdef->table($table)->column($field)->type =~ /(int|serial)/i
) {
$sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
} else {
} values(%result);
}
} else {
- warn "untested code (class FS::$table uses custom new method)";
+ #okay, its been tested
+ # warn "untested code (class FS::$table uses custom new method)";
@return = map {
eval 'FS::'. $table. '->new( { %{$_} } )';
} values(%result);
return @return;
}
+=item by_key PRIMARY_KEY_VALUE
+
+This is a class method that returns the record with the given primary key
+value. This method is only useful in FS::Record subclasses. For example:
+
+ my $cust_main = FS::cust_main->by_key(1); # retrieve customer with custnum 1
+
+is equivalent to:
+
+ my $cust_main = qsearchs('cust_main', { 'custnum' => 1 } );
+
+=cut
+
+sub by_key {
+ my ($class, $pkey_value) = @_;
+
+ my $table = $class->table
+ or croak "No table for $class found";
+
+ my $dbdef_table = dbdef->table($table)
+ or die "No schema for table $table found - ".
+ "do you need to create it or run dbdef-create?";
+ my $pkey = $dbdef_table->primary_key
+ or die "No primary key for table $table";
+
+ return qsearchs($table, { $pkey => $pkey_value });
+}
+
=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
Experimental JOINed search method. Using this method, you can execute a
);
}
-=item qsearchs TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
+=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
Same as qsearch, except that if more than one record matches, it B<carp>s but
returns the first. If this happens, you either made a logic error in asking
sub dbdef_table {
my($self)=@_;
my($table)=$self->table;
- $dbdef->table($table);
+ dbdef->table($table);
}
=item get, getfield COLUMN
$sth->execute or return $sth->errstr;
- my $insertid = '';
- if ( $db_seq ) { # get inserted id from the database, if applicable
+ # get inserted id from the database, if applicable & needed
+ if ( $db_seq && ! $self->getfield($primary_key) ) {
warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
+
+ my $insertid = '';
+
if ( driver_name eq 'Pg' ) {
- my $oid = $sth->{'pg_oid_status'};
- my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+ #my $oid = $sth->{'pg_oid_status'};
+ #my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?";
+
+ my $default = $self->dbdef_table->column($primary_key)->default;
+ unless ( $default =~ /^nextval\('"?([\w\.]+)"?'/i ) {
+ dbh->rollback if $FS::UID::AutoCommit;
+ return "can't parse $table.$primary_key default value".
+ " for sequence name: $default";
+ }
+ my $sequence = $1;
+
+ my $i_sql = "SELECT currval('$sequence')";
my $i_sth = dbh->prepare($i_sql) or do {
dbh->rollback if $FS::UID::AutoCommit;
return dbh->errstr;
};
- $i_sth->execute($oid) or do {
+ #$i_sth->execute($oid) or do {
+ $i_sth->execute() or do {
dbh->rollback if $FS::UID::AutoCommit;
return $i_sth->errstr;
};
}
} else {
+
dbh->rollback if $FS::UID::AutoCommit;
return "don't know how to retreive inserted ids from ". driver_name.
", try using counterfiles (maybe run dbdef-create?)";
+
}
+
$self->setfield($primary_key, $insertid);
+
}
my @virtual_fields =
my $h_sth;
- if ( defined $dbdef->table('h_'. $table) ) {
+ if ( defined dbdef->table('h_'. $table) ) {
my $h_statement = $self->_h_statement('insert');
warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or do {
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_sth;
- if ( defined $dbdef->table('h_'. $self->table) ) {
+ if ( defined dbdef->table('h_'. $self->table) ) {
my $h_statement = $self->_h_statement('delete');
warn "[debug]$me $h_statement\n" if $DEBUG > 2;
$h_sth = dbh->prepare($h_statement) or return dbh->errstr;
my $new = shift;
my $old = shift;
- my $saved = {};
-
if (!defined($old)) {
warn "[debug]$me replace called with no arguments; autoloading old record\n"
if $DEBUG;
warn "[debug]$me $new ->replace $old\n" if $DEBUG;
+ if ( $new->can('replace_check') ) {
+ my $error = $new->replace_check($old);
+ return $error if $error;
+ }
+
return "Records not in same table!" unless $new->table eq $old->table;
my $primary_key = $old->dbdef_table->primary_key;
- return "Can't change $primary_key"
+ return "Can't change primary key $primary_key ".
+ 'from '. $old->getfield($primary_key).
+ ' to ' . $new->getfield($primary_key)
if $primary_key
&& ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
return $error if $error;
# Encrypt for replace
+ my $saved = {};
if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . 'encrypted_fields')) {
foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
$saved->{$field} = $new->getfield($field);
? ($_, $new->getfield($_)) : () } $old->fields;
unless ( keys(%diff) ) {
- carp "[warning]$me $new -> replace $old: records identical";
+ carp "[warning]$me $new -> replace $old: records identical"
+ unless $nowarn_identical;
return '';
}
my $sth = dbh->prepare($statement) or return dbh->errstr;
my $h_old_sth;
- if ( defined $dbdef->table('h_'. $old->table) ) {
+ 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 > 2;
$h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
}
my $h_new_sth;
- if ( defined $dbdef->table('h_'. $new->table) ) {
+ 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 > 2;
$h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
}
sub _h_statement {
- my( $self, $action ) = @_;
+ my( $self, $action, $time ) = @_;
+
+ $time ||= time;
my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
"INSERT INTO h_". $self->table. " ( ".
join(', ', qw(history_date history_user history_action), @fields ).
") VALUES (".
- join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values).
+ join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
")"
;
}
=cut
+my @zip_reqd_countries = qw( CA ); #US implicit...
+
sub ut_zip {
my( $self, $field, $country ) = @_;
if ( $country eq 'US' ) {
$self->getfield($field);
$self->setfield($field,$1);
} else {
- if ( $self->getfield($field) =~ /^\s*$/ ) {
+ if ( $self->getfield($field) =~ /^\s*$/
+ && ( !$country || ! grep { $_ eq $country } @zip_reqd_countries )
+ )
+ {
$self->setfield($field,'');
} else {
$self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
my $table;
$table = $self->table or confess "virtual_fields called on non-table";
- confess "Unknown table $table" unless $dbdef->table($table);
+ confess "Unknown table $table" unless dbdef->table($table);
- return () unless $self->dbdef->table('part_virtual_field');
+ return () unless dbdef->table('part_virtual_field');
unless ( $virtual_fields_cache{$table} ) {
my $query = 'SELECT name from part_virtual_field ' .
sub real_fields {
my $table = shift;
- my($table_obj) = $dbdef->table($table);
+ my($table_obj) = dbdef->table($table);
confess "Unknown table $table" unless $table_obj;
$table_obj->columns;
}
-=item reload_dbdef([FILENAME])
-
-Load a database definition (see L<DBIx::DBSchema>), optionally from a
-non-default filename. This command is executed at startup unless
-I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object.
-
-=cut
-
-sub reload_dbdef {
- my $file = shift || $dbdef_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
-
-Returns the current database definition. See L<DBIx::DBSchema>.
-
-=cut
-
-sub dbdef { $dbdef; }
-
=item _quote VALUE, TABLE, COLUMN
This is an internal function used to construct SQL statements. It returns
sub _quote {
my($value, $table, $column) = @_;
- my $column_obj = $dbdef->table($table)->column($column);
+ my $column_obj = dbdef->table($table)->column($column);
my $column_type = $column_obj->type;
my $nullable = $column_obj->null;
my $self = shift;
my $table = $self->table;
- return {} unless $self->dbdef->table('part_virtual_field');
+ return {} unless dbdef->table('part_virtual_field');
my $dbh = dbh;
my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ".