X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=9ac9d4be622f934dccf5f5d832ea3efa0a440074;hb=62d23e804c666adfde3cdfc906a55a5b1c261f39;hp=960c5702438209d0465976653f35bfbb7f112ab1;hpb=37c309cc6f31f6038c75641c6c21648a92337eb3;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 960c57024..9ac9d4be6 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,13 +2,19 @@ package FS::cust_main; require 5.006; use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card @paytypes); +use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record ); +use vars qw( @EXPORT_OK $DEBUG $me $conf + @encrypted_fields + $import $ignore_expired_card + $skip_fuzzyfiles @fuzzyfields + @paytypes + ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); +use List::Util qw( min ); use Time::Local qw(timelocal); use Data::Dumper; use Tie::IxHash; @@ -20,7 +26,7 @@ use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); -use FS::Record qw( qsearchs qsearch dbdef ); +use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::payby; @@ -40,6 +46,9 @@ use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::cust_location; +use FS::cust_class; +use FS::cust_main_exemption; +use FS::cust_tax_adjustment; use FS::tax_rate; use FS::tax_rate_location; use FS::cust_tax_location; @@ -58,11 +67,8 @@ use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; -use FS::payinfo_Mixin; use FS::TicketSystem; -@ISA = qw( FS::payinfo_Mixin FS::Record ); - @EXPORT_OK = qw( smart_search ); $realtime_bop_decline_quiet = 0; @@ -74,11 +80,13 @@ $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; -$skip_fuzzyfiles = 0; $ignore_expired_card = 0; +$skip_fuzzyfiles = 0; +@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); + @encrypted_fields = ('payinfo', 'paycvv'); -sub nohistory_fields { ('paycvv'); } +sub nohistory_fields { ('payinfo', 'paycvv'); } @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); @@ -294,9 +302,9 @@ IP address from which payment information was received Tax exempt, empty or `Y' -=item otaker +=item usernum -Order taker (assigned automatically, see L) +Order taker (see L) =item comments @@ -363,7 +371,7 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I and I. +Currently available options are: I, I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). @@ -374,6 +382,9 @@ The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B method.) +The I option can be set to an arrayref of tax names. +FS::cust_main_exemption records will be created and inserted. + =cut sub insert { @@ -459,6 +470,24 @@ sub insert { $self->invoicing_list( $invoicing_list ); } + warn " setting cust_main_exemption\n" + if $DEBUG > 1; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + foreach my $taxname ( @$tax_exemption ) { + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + } + if ( $conf->config('cust_main-skeleton_tables') && $conf->config('cust_main-skeleton_custnum') ) { @@ -1295,6 +1324,16 @@ sub delete { } } + foreach my $cust_main_exemption ( + qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ) + ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1306,7 +1345,8 @@ sub delete { } -=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] + Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -1318,6 +1358,11 @@ check_invoicing_list first. Here's an example: $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); +Currently available options are: I. + +The I option can be set to an arrayref of tax names. +FS::cust_main_exemption records will be deleted and inserted as appropriate. + =cut sub replace { @@ -1364,7 +1409,7 @@ sub replace { return $error; } - if ( @param ) { # INVOICING_LIST_ARYREF + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -1374,8 +1419,49 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && - grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { + my %options = @param; + + my $tax_exemption = delete $options{'tax_exemption'}; + if ( $tax_exemption ) { + + my %cust_main_exemption = + map { $_->taxname => $_ } + qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); + + foreach my $taxname ( @$tax_exemption ) { + + next if delete $cust_main_exemption{$taxname}; + + my $cust_main_exemption = new FS::cust_main_exemption { + 'custnum' => $self->custnum, + 'taxname' => $taxname, + }; + my $error = $cust_main_exemption->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main_exemption (transaction rolled back): $error"; + } + } + + foreach my $cust_main_exemption ( values %cust_main_exemption ) { + my $error = $cust_main_exemption->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "deleting cust_main_exemption (transaction rolled back): $error"; + } + } + + } + + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ + && ( ( $self->get('payinfo') ne $old->get('payinfo') + && $self->get('payinfo') !~ /^99\d{14}$/ + ) + || grep { $self->get($_) ne $old->get($_) } qw(paydate payname) + ) + ) + { + # card/check/lec info has changed, want to retry realtime_ invoice events my $error = $self->retry_realtime; if ( $error ) { @@ -1418,9 +1504,7 @@ sub queue_fuzzyfiles_update { my $dbh = dbh; my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), - qw(first last company) - ); + my $error = $queue->insert( map $self->getfield($_), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1428,9 +1512,7 @@ sub queue_fuzzyfiles_update { if ( $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), - qw(first last company) - ); + $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1461,6 +1543,7 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') @@ -1479,6 +1562,7 @@ sub check { || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') + || $self->ut_floatn('cdr_termination_percentage') ; #barf. need message catalogs. i18n. etc. @@ -1496,6 +1580,13 @@ sub check { unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); + if ( $self->censustract ne '' ) { + $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ + or return "Illegal census tract: ". $self->censustract; + + $self->censustract("$1.$2"); + } + if ( $self->ss eq '' ) { $self->ss(''); } else { @@ -1643,7 +1734,8 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') - if cardtype($self->payinfo) eq "Unknown"; + if $self->payinfo !~ /^99\d{14}$/ #token + && cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { @@ -1763,6 +1855,8 @@ sub check { my( $m, $y ); if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); + } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { + ( $m, $y ) = ( $2, "19$1" ); } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { @@ -1787,7 +1881,7 @@ sub check { $self->payname($1); } - foreach my $flag (qw( tax spool_cdr squelch_cdr archived )) { + foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) { $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); $self->$flag($1); } @@ -1824,6 +1918,25 @@ sub has_ship_address { scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } +=item location_hash + +Returns a list of key/value pairs, with the following keys: address1, adddress2, +city, county, state, zip, country. The shipping address is used if present. + +=cut + +#geocode? dependent on tax-ship_address config, not available in cust_location +#mostly. not yet then. + +sub location_hash { + my $self = shift; + my $prefix = $self->has_ship_address ? 'ship_' : ''; + + map { $_ => $self->get($prefix.$_) } + qw( address1 address2 city county state zip country geocode ); + #fields that cust_location has +} + =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L) for this customer. @@ -1867,6 +1980,61 @@ sub cust_location { qsearch('cust_location', { 'custnum' => $self->custnum } ); } +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the service location (see analog in L) for this customer. + +Options are + +=over 4 + +=item join_string + +used to separate the address elements (defaults to ', ') + +=item escape_function + +a callback used for escaping the text of the address elements + +=back + +=cut + +# false laziness with FS::cust_location::line + +sub location_label { + my $self = shift; + my %opt = @_; + + my $separator = $opt{join_string} || ', '; + my $escape = $opt{escape_function} || sub{ shift }; + my $line = ''; + my $cydefault = FS::conf->new->config('countrydefault') || 'US'; + my $prefix = length($self->ship_last) ? 'ship_' : ''; + + my $notfirst = 0; + foreach (qw ( address1 address2 ) ) { + my $method = "$prefix$_"; + $line .= ($notfirst ? $separator : ''). &$escape($self->$method) + if $self->$method; + $notfirst++; + } + $notfirst = 0; + foreach (qw ( city county state zip ) ) { + my $method = "$prefix$_"; + if ( $self->$method ) { + $line .= ' (' if $method eq 'county'; + $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method); + $line .= ' )' if $method eq 'county'; + $notfirst++; + } + } + $line .= $separator. &$escape(code2country($self->country)) + if $self->country ne $cydefault; + + $line; +} + =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L) for this customer. @@ -1928,6 +2096,9 @@ sub _cust_pkg { # This should be generalized to use config options to determine order. sub sort_packages { + my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 ); + return $locationsort if $locationsort; + if ( $a->get('cancel') xor $b->get('cancel') ) { return -1 if $b->get('cancel'); return 1 if $a->get('cancel'); @@ -1983,6 +2154,18 @@ sub unsuspended_pkgs { grep { ! $_->susp } $self->ncancelled_pkgs; } +=item next_bill_date + +Returns the next date this customer will be billed, as a UNIX timestamp, or +undef if no active package has a next bill date. + +=cut + +sub next_bill_date { + my $self = shift; + min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs ); +} + =item num_cancelled_pkgs Returns the number of cancelled packages (see L) for this @@ -2114,12 +2297,16 @@ Available options are: =item ban - can be set true to ban this customer's credit card or ACH information, if present. +=item nobill - can be set true to skip billing if it might otherwise be done. + =back Always returns a list: an empty list on success or a list of errors. =cut +# nb that dates are not specified as valid options to this method + sub cancel { my( $self, %opt ) = @_; @@ -2145,6 +2332,13 @@ sub cancel { my @pkgs = $self->ncancelled_pkgs; + if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) { + $opt{nobill} = 1; + my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 ); + warn "Error billing during cancel, custnum ". $self->custnum. ": $error" + if $error; + } + warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". scalar(@pkgs). " packages for customer ". $self->custnum. "\n" if $DEBUG; @@ -2196,12 +2390,61 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } +=item cust_class + +Returns the customer class, as an FS::cust_class object, or the empty string +if there is no customer class. + +=cut + +sub cust_class { + my $self = shift; + if ( $self->classnum ) { + qsearchs('cust_class', { 'classnum' => $self->classnum } ); + } else { + return ''; + } +} + +=item categoryname + +Returns the customer category name, or the empty string if there is no customer +category. + +=cut + +sub categoryname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->categoryname + : ''; +} + +=item classname + +Returns the customer class name, or the empty string if there is no customer +class. + +=cut + +sub classname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->classname + : ''; +} + + =item bill_and_collect Cancels and suspends any packages due, generates bills, applies payments and -cred +credits, and applies collection events to run cards, send bills and notices, +etc. -Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.) +By default, warns on errors and continues with the next operation (but see the +"fatal" flag below). Options are passed as name-value pairs. Currently available options are: @@ -2227,43 +2470,89 @@ Used in conjunction with the I