X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=9d40e7306683c36c428e8bcc38b4b4195da2537c;hb=f04616ad2c32641c1b85820cb97bcb22edbbc9f5;hp=a41415b6baf3b1b0abd7e20b4538634252909ec3;hpb=36d1c468816c940f288e20094fd5b62d4f2580af;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index a41415b6b..9d40e7306 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -9,7 +9,8 @@ use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); -use Time::Local qw(timelocal timelocal_nocheck); +use List::Util qw( min ); +use Time::Local qw(timelocal); use Data::Dumper; use Tie::IxHash; use Digest::MD5 qw(md5_base64); @@ -23,11 +24,14 @@ use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); +use FS::payby; use FS::cust_pkg; use FS::cust_svc; 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; @@ -36,7 +40,11 @@ use FS::cust_credit; use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; +use FS::cust_location; +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; @@ -73,6 +81,8 @@ $skip_fuzzyfiles = 0; $ignore_expired_card = 0; @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 @@ -135,101 +145,181 @@ FS::Record. The following fields are currently supported: =over 4 -=item custnum - primary key (assigned automatically for new customers) +=item custnum + +Primary key (assigned automatically for new customers) + +=item agentnum + +Agent (see L) + +=item refnum + +Advertising source (see L) + +=item first -=item agentnum - agent (see L) +First name -=item refnum - Advertising source (see L) +=item last -=item first - name +Last name -=item last - name +=item ss -=item ss - social security number (optional) +Cocial security number (optional) -=item company - (optional) +=item company + +(optional) =item address1 -=item address2 - (optional) +=item address2 + +(optional) =item city -=item county - (optional, see L) +=item county + +(optional, see L) + +=item state -=item state - (see L) +(see L) =item zip -=item country - (see L) +=item country + +(see L) + +=item daytime + +phone (optional) + +=item night -=item daytime - phone (optional) +phone (optional) -=item night - phone (optional) +=item fax -=item fax - phone (optional) +phone (optional) -=item ship_first - name +=item ship_first -=item ship_last - name +Shipping first name -=item ship_company - (optional) +=item ship_last + +Shipping last name + +=item ship_company + +(optional) =item ship_address1 -=item ship_address2 - (optional) +=item ship_address2 + +(optional) =item ship_city -=item ship_county - (optional, see L) +=item ship_county -=item ship_state - (see L) +(optional, see L) + +=item ship_state + +(see L) =item ship_zip -=item ship_country - (see L) +=item ship_country + +(see L) + +=item ship_daytime -=item ship_daytime - phone (optional) +phone (optional) -=item ship_night - phone (optional) +=item ship_night -=item ship_fax - phone (optional) +phone (optional) -=item payby - Payment Type (See L for valid payby values) +=item ship_fax -=item payinfo - Payment Information (See L for data format) +phone (optional) -=item paymask - Masked payinfo (See L for how this works) +=item payby + +Payment Type (See L for valid payby values) + +=item payinfo + +Payment Information (See L for data format) + +=item paymask + +Masked payinfo (See L for how this works) =item paycvv Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +=item paydate + +Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy + +=item paystart_month -=item paystart_month - start date month (maestro/solo cards only) +Start date month (maestro/solo cards only) -=item paystart_year - start date year (maestro/solo cards only) +=item paystart_year -=item payissue - issue number (maestro/solo cards only) +Start date year (maestro/solo cards only) -=item payname - name on card or billing name +=item payissue -=item payip - IP address from which payment information was received +Issue number (maestro/solo cards only) -=item tax - tax exempt, empty or `Y' +=item payname -=item otaker - order taker (assigned automatically, see L) +Name on card or billing name -=item comments - comments (optional) +=item payip -=item referral_custnum - referring customer number +IP address from which payment information was received -=item spool_cdr - Enable individual CDR spooling, empty or `Y' +=item tax -=item dundate - a suggestion to events (see L) to delay until this unix timestamp +Tax exempt, empty or `Y' -=item squelch_cdr - Discourage individual CDR printing, empty or `Y' +=item otaker + +Order taker (assigned automatically, see L) + +=item comments + +Comments (optional) + +=item referral_custnum + +Referring customer number + +=item spool_cdr + +Enable individual CDR spooling, empty or `Y' + +=item dundate + +A suggestion to events (see L) to delay until this unix timestamp + +=item squelch_cdr + +Discourage individual CDR printing, empty or `Y' =back @@ -276,7 +366,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). @@ -287,6 +377,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 { @@ -310,7 +403,7 @@ sub insert { my $dbh = dbh; my $prepay_identifier = ''; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); my $payby = ''; if ( $self->payby eq 'PREPAY' ) { @@ -321,7 +414,13 @@ sub insert { warn " looking up prepaid card $prepay_identifier\n" if $DEBUG > 1; - my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); + my $error = $self->get_prepay( $prepay_identifier, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "error applying prepaid card (transaction rolled back): $error"; @@ -366,6 +465,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') ) { @@ -383,7 +500,13 @@ sub insert { warn " ordering packages\n" if $DEBUG > 1; - $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); + $error = $self->order_pkgs( $cust_pkgs, + %options, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -393,6 +516,10 @@ sub insert { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } + if ( $upbytes || $downbytes || $totalbytes ) { + $dbh->rollback if $oldAutoCommit; + return "No svc_acct record to apply pre-paid data"; + } if ( $amount ) { warn " inserting initial $payby payment of $amount\n" @@ -578,12 +705,129 @@ sub _copy_skel { } -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] +=item order_pkg HASHREF | OPTION => VALUE ... + +Orders a single package. + +Options may be passed as a list of key/value pairs or as a hash reference. +Options are: + +=over 4 + +=item cust_pkg + +FS::cust_pkg object + +=item cust_location + +Optional FS::cust_location object + +=item svcs + +Optional arryaref of FS::svc_* service objects. + +=item depend_jobnum + +If this option is set to a job queue jobnum (see L), all provisioning +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 + +sub order_pkg { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + + warn "$me order_pkg called with options ". + join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n" + if $DEBUG; + + my $cust_pkg = $opt->{'cust_pkg'}; + my $svcs = $opt->{'svcs'} || []; + + my %svc_options = (); + $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'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + if ( $opt->{'cust_location'} && + ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) { + my $error = $opt->{'cust_location'}->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_location (transaction rolled back): $error"; + } + $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); + } + + $cust_pkg->custnum( $self->custnum ); + + my $error = $cust_pkg->insert( %insert_params ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_pkg (transaction rolled back): $error"; + } + + foreach my $svc_something ( @{ $opt->{'svcs'} } ) { + if ( $svc_something->svcnum ) { + my $old_cust_svc = $svc_something->cust_svc; + my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; + $new_cust_svc->pkgnum( $cust_pkg->pkgnum); + $error = $new_cust_svc->replace($old_cust_svc); + } else { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $svc_something->isa('FS::svc_acct') ) { + foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } } + qw( seconds upbytes downbytes totalbytes ) ) { + $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } ); + ${ $opt->{$_.'_ref'} } = 0; + } + } + $error = $svc_something->insert(%svc_options); + } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting svc_ (transaction rolled back): $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + +} + +#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ] +=item order_pkgs HASHREF [ , OPTION => VALUE ... ] -Like the insert method on an existing record, this method orders a package -and included services atomicaly. Pass a Tie::RefHash data structure to this -method containing FS::cust_pkg and FS::svc_I objects. There should -be a better explanation of this, but until then, here's an example: +Like the insert method on an existing record, this method orders multiple +packages and included services atomicaly. Pass a Tie::RefHash data structure +to this method containing FS::cust_pkg and FS::svc_I objects. +There should be a better explanation of this, but until then, here's an +example: use Tie::RefHash; tie %hash, 'Tie::RefHash'; #this part is important @@ -591,12 +835,13 @@ be a better explanation of this, but until then, here's an example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); Services can be new, in which case they are inserted, or existing unaudited services, in which case they are linked to the newly-created package. -Currently available options are: I and I. +Currently available options are: I, I, I, +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). @@ -609,16 +854,19 @@ the B method for each cust_pkg object. Using the B method on the cust_main object is not recommended, as existing services will also be reexported.) +If I, I, I, or I is +provided, the scalars (provided by references) will be incremented by the +values of the prepaid card.` + =cut sub order_pkgs { my $self = shift; my $cust_pkgs = shift; - my $seconds = shift; + my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated my %options = @_; - my %svc_options = (); - $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} - if exists $options{'depend_jobnum'}; + $seconds_ref ||= $options{'seconds_ref'}; + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -637,32 +885,20 @@ sub order_pkgs { local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; + + my $error = $self->order_pkg( + 'cust_pkg' => $cust_pkg, + 'svcs' => $cust_pkgs->{$cust_pkg}, + 'seconds_ref' => $seconds_ref, + map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref + depend_jobnum + ) + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - if ( $svc_something->svcnum ) { - my $old_cust_svc = $svc_something->cust_svc; - my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; - $new_cust_svc->pkgnum( $cust_pkg->pkgnum); - $error = $new_cust_svc->replace($old_cust_svc); - } else { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } + return $error; } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -676,13 +912,14 @@ L), specified either by I or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. -Optionally, four scalar references can be passed as well. They will have their -values filled in with the amount, number of seconds, and number of upload and -download bytes applied by this prepaid -card. +Optionally, five scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload, +download, and total bytes applied by this prepaid card. =cut +#the ref bullshit here should be refactored like get_prepay. MyAccount.pm is +#the only place that uses these args sub recharge_prepay { my( $self, $prepay_credit, $amountref, $secondsref, $upbytesref, $downbytesref, $totalbytesref ) = @_; @@ -700,8 +937,13 @@ sub recharge_prepay { my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, - \$seconds, \$upbytes, \$downbytes, \$totalbytes) + my $error = $self->get_prepay( $prepay_credit, + 'amount_ref' => \$amount, + 'seconds_ref' => \$seconds, + 'upbytes_ref' => \$upbytes, + 'downbytes_ref' => \$downbytes, + 'totalbytes_ref' => \$totalbytes, + ) || $self->increment_seconds($seconds) || $self->increment_upbytes($upbytes) || $self->increment_downbytes($downbytes) @@ -728,13 +970,13 @@ sub recharge_prepay { } -=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] Looks up and deletes a prepaid card (see L), specified either by I or as an FS::prepay_credit object. -References to I and I scalars should be passed as arguments -and will be incremented by the values of the prepaid card. +Available options are: I, I, I, I, and I. The scalars (provided by references) will be +incremented by the values of the prepaid card. If the prepaid card specifies an I (see L), it is used to check or set this customer's I. @@ -745,8 +987,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref, - $upref, $downref, $totalref) = @_; + my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -791,11 +1032,8 @@ sub get_prepay { return "removing prepay_credit (transaction rolled back): $error"; } - $$amountref += $prepay_credit->amount; - $$secondsref += $prepay_credit->seconds; - $$upref += $prepay_credit->upbytes; - $$downref += $prepay_credit->downbytes; - $$totalref += $prepay_credit->totalbytes; + ${ $opt{$_.'_ref'} } += $prepay_credit->$_() + for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1081,6 +1319,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; @@ -1092,7 +1340,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. @@ -1104,6 +1353,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 { @@ -1150,7 +1404,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 ) { @@ -1160,6 +1414,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 @@ -1265,6 +1553,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. @@ -1282,6 +1571,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 { @@ -1549,6 +1845,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 { @@ -1573,7 +1871,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); } @@ -1610,7 +1908,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. @@ -1618,14 +1916,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; @@ -1641,7 +1940,18 @@ sub cust_pkg { shift->all_pkgs(@_); } -=item ncancelled_pkgs +=item cust_location + +Returns all locations (see L) for this customer. + +=cut + +sub cust_location { + my $self = shift; + qsearch('cust_location', { 'custnum' => $self->custnum } ); +} + +=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L) for this customer. @@ -1649,6 +1959,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; @@ -1667,33 +1978,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 @@ -1733,6 +2067,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 @@ -1864,12 +2210,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 ) = @_; @@ -1895,6 +2245,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; @@ -1983,23 +2340,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 ) : () @@ -2009,24 +2388,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') @@ -2042,18 +2429,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 @@ -2085,10 +2460,21 @@ 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