X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=1a88c3acddd27bc0d9a60017dbc611a434b34743;hb=a180208786cccb72ab017e39fff0cb128aa6ba01;hp=59472c898be12b76274372a207af0e70a39a556e;hpb=7f07089722bfcabe3bf42619bb2bdb81fd8d44e1;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 59472c898..1a88c3acd 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,25 +1,78 @@ package FS::Record; +use base qw( Exporter ); use strict; -use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG); -use subs qw(reload_dbdef); -use Exporter; +use vars qw( $AUTOLOAD + %virtual_fields_cache + $money_char $lat_lower $lon_upper + ); use Carp qw(carp cluck croak confess); +use Scalar::Util qw( blessed ); +use File::Slurp qw( slurp ); use File::CounterFile; -use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); -use FS::dbdef; - -@ISA = qw(Exporter); -@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); - -$DEBUG = 0; +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 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 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 + midnight_sql +); + +our $DEBUG = 0; +our $me = '[FS::Record]'; + +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; + +our $conf = ''; +our $conf_encryption = ''; +FS::UID->install_callback( sub { + + eval "use FS::Conf;"; + die $@ if $@; + $conf = FS::Conf->new; + $conf_encryption = $conf->exists('encryption'); + $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?'; }"; + } -#ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::Record'} = sub { - $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 @@ -28,7 +81,7 @@ FS::Record - Database record objects =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', ... }; @@ -54,34 +107,32 @@ FS::Record - Database record objects $hashref = $record->hashref; $error = $record->insert; - #$error = $record->add; #depriciated $error = $record->delete; - #$error = $record->del; #depriciated $error = $new_record->replace($old_record); - #$error = $new_record->rep($old_record); #depriciated + # external use deprecated - handled by the database (at least for Pg, mysql) $value = $record->unique('column'); - $value = $record->ut_float('column'); - $value = $record->ut_number('column'); - $value = $record->ut_numbern('column'); - $value = $record->ut_money('column'); - $value = $record->ut_text('column'); - $value = $record->ut_textn('column'); - $value = $record->ut_alpha('column'); - $value = $record->ut_alphan('column'); - $value = $record->ut_phonen('column'); - $value = $record->ut_anythingn('column'); - - $dbdef = reload_dbdef; - $dbdef = reload_dbdef "/non/standard/filename"; - $dbdef = dbdef; + $error = $record->ut_float('column'); + $error = $record->ut_floatn('column'); + $error = $record->ut_number('column'); + $error = $record->ut_numbern('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'); - #depriciated + #deprecated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @@ -118,22 +169,45 @@ sub new { 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->_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; - - foreach my $field ( $self->fields ) { - $hashref->{$field}='' unless defined $hashref->{$field}; - #trim the '$' and ',' from money fields for Pg (belong HERE?) - #(what about Pg i18n?) - if ( driver_name eq 'Pg' - && $self->dbdef_table->column($field)->type eq 'money' ) { - ${$hashref}{$field} =~ s/^\$//; - ${$hashref}{$field} =~ s/\,//; - } + 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); } - $self; } sub create { @@ -142,72 +216,641 @@ sub create { my $self = {}; bless ($self, $class); if ( defined $self->table ) { - cluck "create constructor is depriciated, use new!"; + cluck "create constructor is deprecated, use new!"; $self->new(@_); } else { croak "FS::Record::create called (not from a subclass)!"; } } -=item qsearch TABLE, HASHREF +=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