package FS::Record; use base qw( Exporter ); use strict; use charnames ':full'; use vars qw( $AUTOLOAD %virtual_fields_cache %fk_method_cache $fk_table_cache %virtual_fields_hash_cache $money_char $lat_lower $lon_upper $use_placeholders ); use Carp qw(carp cluck croak confess); use Scalar::Util qw( blessed ); use File::Slurp qw( slurp ); use File::CounterFile; use Text::CSV_XS; use DBI qw(:sql_types); use DBIx::DBSchema 0.43; #0.43 for foreign keys 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); use FS::SearchCache; use FS::Msgcat qw(gettext); #use FS::Conf; #dependency loop bs, in install_callback below instead use Email::Valid; use FS::part_virtual_field; use Tie::IxHash; our @encrypt_payby = qw( CARD DCRD CHEK DCHK ); #export dbdef for now... everything else expects to find it here our @EXPORT_OK = qw( dbh fields hfields qsearch qsearchs dbdef jsearch str2time_sql str2time_sql_closing regexp_sql not_regexp_sql concat_sql group_concat_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_history = 0; our $qsearch_qualify_columns = 1; our $no_check_foreign = 1; #well, not inefficiently in perl by default anymore my $rsa_encrypt; my $rsa_decrypt; our $conf = ''; our $conf_encryption = ''; our $conf_encryptionmodule = ''; our $conf_encryptionpublickey = ''; our $conf_encryptionprivatekey = ''; FS::UID->install_callback( sub { eval "use FS::Conf;"; die $@ if $@; $conf = FS::Conf->new; $conf_encryption = $conf->exists('encryption'); $conf_encryptionmodule = $conf->config('encryptionmodule'); $conf_encryptionpublickey = join("\n",$conf->config('encryptionpublickey')); $conf_encryptionprivatekey = join("\n",$conf->config('encryptionprivatekey')); $money_char = $conf->config('money_char') || '$'; my $nw_coords = $conf->exists('geocode-require_nw_coordinates'); $lat_lower = $nw_coords ? 1 : -90; $lon_upper = $nw_coords ? -1 : 180; $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?'; }"; } #fk_methods_init(); } ); =head1 NAME FS::Record - Database record objects =head1 SYNOPSIS use FS::Record; use FS::Record qw(dbh fields qsearch qsearchs); $record = new FS::Record 'table', \%hash; $record = new FS::Record 'table', { 'column' => 'value', ... }; $record = qsearchs FS::Record 'table', \%hash; $record = qsearchs FS::Record 'table', { 'column' => 'value', ... }; @records = qsearch FS::Record 'table', \%hash; @records = qsearch FS::Record 'table', { 'column' => 'value', ... }; $table = $record->table; $dbdef_table = $record->dbdef_table; $value = $record->get('column'); $value = $record->getfield('column'); $value = $record->column; $record->set( 'column' => 'value' ); $record->setfield( 'column' => 'value' ); $record->column('value'); %hash = $record->hash; $hashref = $record->hashref; $error = $record->insert; $error = $record->delete; $error = $new_record->replace($old_record); # external use deprecated - handled by the database (at least for Pg, mysql) $value = $record->unique('column'); $error = $record->ut_float('column'); $error = $record->ut_floatn('column'); $error = $record->ut_number('column'); $error = $record->ut_numbern('column'); $error = $record->ut_decimal('column'); $error = $record->ut_decimaln('column'); $error = $record->ut_snumber('column'); $error = $record->ut_snumbern('column'); $error = $record->ut_money('column'); $error = $record->ut_text('column'); $error = $record->ut_textn('column'); $error = $record->ut_alpha('column'); $error = $record->ut_alphan('column'); $error = $record->ut_phonen('column'); $error = $record->ut_anything('column'); $error = $record->ut_name('column'); $quoted_value = _quote($value,'table','field'); #deprecated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @fields = fields 'table'; #as a subroutine @fields = $record->fields; #as a method call =head1 DESCRIPTION (Mostly) object-oriented interface to database records. Records are currently implemented on top of DBI. FS::Record is intended as a base class for table-specific classes to inherit from, i.e. FS::cust_main. =head1 CONSTRUCTORS =over 4 =item new [ TABLE, ] HASHREF Creates a new record. It doesn't store it in the database, though. See L<"insert"> for that. Note that the object stores this hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the I method. TABLE can only be omitted when a dervived class overrides the table method. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); unless ( defined ( $self->table ) ) { $self->{'Table'} = shift; carp "warning: FS::Record::new called with table name ". $self->{'Table'} unless $nowarn_classload; } $self->{'Hash'} = shift; foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { $self->{'Hash'}{$field}=''; } $self->_rebless if $self->can('_rebless'); $self->{'modified'} = 0; $self->_simplecache($self->{'Hash'}) if $self->can('_simplecache'); $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_; $self; } sub new_or_cached { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); $self->{'Table'} = shift unless defined ( $self->table ); my $hashref = $self->{'Hash'} = shift; my $cache = shift; if ( defined( $cache->cache->{$hashref->{$cache->key}} ) ) { my $obj = $cache->cache->{$hashref->{$cache->key}}; $obj->_cache($hashref, $cache) if $obj->can('_cache'); $obj; } else { $cache->cache->{$hashref->{$cache->key}} = $self->new($hashref, $cache); } } sub create { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); if ( defined $self->table ) { cluck "create constructor is deprecated, use new!"; $self->new(@_); } else { croak "FS::Record::create called (not from a subclass)!"; } } =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: @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 @records = qsearch( 'table', { 'field' => 'value' } ); Also possible is an experimental LISTREF of PARAMS_HASHREFs for a UNION of the individual PARAMS_HASHREF queries ###oops, argh, FS::Record::new only lets us create database fields. #Normal behaviour if SELECT is not specified is `*', as in #C