X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=5d6826f485e6b14c003ccb15ce0e4391e149469d;hb=1c2b820bd8d41fb9620e81faf617adffe85dbd33;hp=27a617e1aecc20264ae72ccbbcf2c6d8a62327b2;hpb=fd1bf67102a849280d78a041eff33e87c3cc7179;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 27a617e1a..5d6826f48 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,13 +2,18 @@ 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 vars qw( @ISA @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; @@ -30,6 +35,7 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_bill_pkg_display; use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -39,7 +45,11 @@ 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; use FS::part_pkg_taxrate; use FS::agent; @@ -72,10 +82,14 @@ $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'); } + @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later @@ -359,7 +373,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). @@ -370,6 +384,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 { @@ -455,6 +472,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') ) { @@ -705,6 +740,14 @@ jobs will have a dependancy on the supplied job (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such as running the customer's credit card successfully). +=item ticket_subject + +Optional subject for a ticket created and attached to this customer + +=item ticket_subject + +Optional queue name for ticket additions + =back =cut @@ -724,6 +767,9 @@ sub order_pkg { $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'} if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; + my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } + qw( ticket_subject ticket_queue ); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -747,7 +793,7 @@ sub order_pkg { $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; + my $error = $cust_pkg->insert( %insert_params ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_pkg (transaction rolled back): $error"; @@ -1280,6 +1326,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; @@ -1291,7 +1347,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. @@ -1303,6 +1360,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 { @@ -1349,7 +1411,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 ) { @@ -1359,6 +1421,40 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + 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)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { # card/check/lec info has changed, want to retry realtime_ invoice events @@ -1403,9 +1499,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"; @@ -1413,9 +1507,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"; @@ -1446,6 +1538,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') @@ -1464,6 +1557,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. @@ -1481,6 +1575,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 { @@ -1748,6 +1849,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 { @@ -1772,7 +1875,7 @@ sub check { $self->payname($1); } - foreach my $flag (qw( tax spool_cdr squelch_cdr )) { + 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); } @@ -1809,7 +1912,7 @@ sub has_ship_address { scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } -=item all_pkgs +=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L) for this customer. @@ -1817,14 +1920,15 @@ Returns all packages (see L) for this customer. sub all_pkgs { my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; - return $self->num_pkgs unless wantarray; + return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { - @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + @cust_pkg = $self->_cust_pkg($extra_qsearch); } sort sort_packages @cust_pkg; @@ -1851,7 +1955,7 @@ sub cust_location { qsearch('cust_location', { 'custnum' => $self->custnum } ); } -=item ncancelled_pkgs +=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L) for this customer. @@ -1859,6 +1963,7 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; return $self->num_ncancelled_pkgs unless wantarray; @@ -1877,33 +1982,56 @@ sub ncancelled_pkgs { $self->custnum. "\n" if $DEBUG > 1; - @cust_pkg = - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }); - push @cust_pkg, - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }); + $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) '; + + @cust_pkg = $self->_cust_pkg($extra_qsearch); + } sort sort_packages @cust_pkg; } +sub _cust_pkg { + my $self = shift; + my $extra_qsearch = ref($_[0]) ? shift : {}; + + $extra_qsearch->{'select'} ||= '*'; + $extra_qsearch->{'select'} .= + ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum ) + AS _num_cust_svc'; + + map { + $_->{'_num_cust_svc'} = $_->get('_num_cust_svc'); + $_; + } + qsearch({ + %$extra_qsearch, + 'table' => 'cust_pkg', + 'hashref' => { 'custnum' => $self->custnum }, + }); + +} + # This should be generalized to use config options to determine order. sub sort_packages { - if ( $a->get('cancel') and $b->get('cancel') ) { - $a->pkgnum <=> $b->pkgnum; - } elsif ( $a->get('cancel') or $b->get('cancel') ) { + + if ( $a->get('cancel') xor $b->get('cancel') ) { return -1 if $b->get('cancel'); return 1 if $a->get('cancel'); + #shouldn't get here... return 0; } else { - $a->pkgnum <=> $b->pkgnum; + my $a_num_cust_svc = $a->num_cust_svc; + my $b_num_cust_svc = $b->num_cust_svc; + return 0 if !$a_num_cust_svc && !$b_num_cust_svc; + return -1 if $a_num_cust_svc && !$b_num_cust_svc; + return 1 if !$a_num_cust_svc && $b_num_cust_svc; + my @a_cust_svc = $a->cust_svc; + my @b_cust_svc = $b->cust_svc; + $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; } + } =item suspended_pkgs @@ -1943,6 +2071,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 @@ -2074,12 +2214,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 ) = @_; @@ -2105,6 +2249,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; @@ -2156,6 +2307,53 @@ 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 @@ -2193,23 +2391,45 @@ Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in opt =back +Options are passed to the B and B methods verbatim, so all +options of those methods are also available. + =cut sub bill_and_collect { my( $self, %options ) = @_; - ### - # cancel packages - ### - #$options{actual_time} not $options{time} because freeside-daily -d is for #pre-printing invoices - my @cancel_pkgs = grep { $_->expire && $_->expire <= $options{actual_time} } - $self->ncancelled_pkgs; + $self->cancel_expired_pkgs( $options{actual_time} ); + $self->suspend_adjourned_pkgs( $options{actual_time} ); + + my $error = $self->bill( %options ); + warn "Error billing, custnum ". $self->custnum. ": $error" if $error; + + $self->apply_payments_and_credits; + + unless ( $conf->exists('cancelled_cust-noevents') + && ! $self->num_ncancelled_pkgs + ) { + + $error = $self->collect( %options ); + warn "Error collecting, custnum". $self->custnum. ": $error" if $error; + + } + +} + +sub cancel_expired_pkgs { + my ( $self, $time ) = @_; + + my @cancel_pkgs = $self->ncancelled_pkgs( { + 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time " + } ); foreach my $cust_pkg ( @cancel_pkgs ) { my $cpr = $cust_pkg->last_cust_pkg_reason('expire'); - my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, + my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, 'reason_otaker' => $cpr->otaker ) : () @@ -2219,24 +2439,32 @@ sub bill_and_collect { if $error; } - ### - # suspend packages - ### +} - #$options{actual_time} not $options{time} because freeside-daily -d is for - #pre-printing invoices - my @susp_pkgs = - grep { ! $_->susp - && ( ( $_->part_pkg->is_prepaid - && $_->bill - && $_->bill < $options{actual_time} - ) - || ( $_->adjourn - && $_->adjourn <= $options{actual_time} - ) - ) +sub suspend_adjourned_pkgs { + my ( $self, $time ) = @_; + + my @susp_pkgs = $self->ncancelled_pkgs( { + 'extra_sql' => + " AND ( susp IS NULL OR susp = 0 ) + AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time ) + OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time ) + ) + ", + } ); + + #only because there's no SQL test for is_prepaid :/ + @susp_pkgs = + grep { ( $_->part_pkg->is_prepaid + && $_->bill + && $_->bill < $time + ) + || ( $_->adjourn + && $_->adjourn <= $time + ) + } - $self->ncancelled_pkgs; + @susp_pkgs; foreach my $cust_pkg ( @susp_pkgs ) { my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn') @@ -2252,18 +2480,6 @@ sub bill_and_collect { if $error; } - ### - # bill and collect - ### - - my $error = $self->bill( %options ); - warn "Error billing, custnum ". $self->custnum. ": $error" if $error; - - $self->apply_payments_and_credits; - - $error = $self->collect( %options ); - warn "Error collecting, custnum". $self->custnum. ": $error" if $error; - } =item bill OPTIONS @@ -2295,10 +2511,26 @@ An array ref of specific packages (objects) to attempt billing, instead trying a $cust_main->bill( pkg_list => [$pkg1, $pkg2] ); +=item not_pkgpart + +A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar). + =item invoice_time Used in conjunction with the I