X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=6c18f93a1cf41bac23bfb91a1f0fab0b56f4e591;hb=5e25b996982d42eb2587ec54db0d5b39508aa730;hp=0a7f1f7cb968f2b85693280dc65db167458b128d;hpb=8ca6f203e5dae208d7af581d68671fe47c5e1a1a;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0a7f1f7cb..6c18f93a1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -3,7 +3,7 @@ package FS::cust_main; use strict; use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from $smtpmachine $Debug $bop_processor $bop_login $bop_password - $bop_action @bop_options); + $bop_action @bop_options $import ); use Safe; use Carp; use Time::Local; @@ -28,12 +28,15 @@ use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; +use FS::part_pkg; @ISA = qw( FS::Record ); $Debug = 0; #$Debug = 1; +$import = 0; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_main'} = sub { $conf = new FS::Conf; @@ -75,6 +78,18 @@ $FS::UID::callback{'FS::cust_main'} = sub { } }; +sub _cache { + my $self = shift; + my ( $hashref, $cache ) = @_; + if ( exists $hashref->{'pkgnum'} ) { +# #@{ $self->{'_pkgnum'} } = (); + my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); + $self->{'_pkgnum'} = $subcache; + #push @{ $self->{'_pkgnum'} }, + FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum}; + } +} + =head1 NAME FS::cust_main - Object methods for cust_main records @@ -98,6 +113,8 @@ FS::cust_main - Object methods for cust_main records @cust_pkg = $record->ncancelled_pkgs; + @cust_pkg = $record->suspended_pkgs; + $error = $record->bill; $error = $record->bill %options; $error = $record->bill 'time' => $time; @@ -214,10 +231,9 @@ otherwise returns false. CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert method containing FS::cust_pkg and FS::svc_I objects, all records -are inserted atomicly, or the transaction is rolled back (this requries a -transactional database). Passing an empty hash reference is equivalent to -not supplying this parameter. There should be a better explanation of this, -but until then, here's an example: +are inserted atomicly, or the transaction is rolled back. Passing an empty +hash reference is equivalent to not supplying this parameter. 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 @@ -231,7 +247,7 @@ INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will be set as the invoicing list (see L<"invoicing_list">). Errors return as expected and rollback the entire transaction; it is not necessary to call check_invoicing_list first. The invoicing_list is set after the records in the -CUST_PKG_HASHREF above are inserted, so it is now possible set set an +CUST_PKG_HASHREF above are inserted, so it is now possible to set an invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); @@ -361,11 +377,13 @@ This will completely remove all traces of the customer record. This is not what you want when a customer cancels service; for that, cancel all of the customer's packages (see L). -If the customer has any packages, you need to pass a new (valid) customer -number for those packages to be transferred to. +If the customer has any uncancelled packages, you need to pass a new (valid) +customer number for those packages to be transferred to. Cancelled packages +will be deleted. Did I mention that this is NOT what you want when a customer +cancels service and that you really should be looking see L? You can't delete a customer with invoices (see L), -or credits (see L). +or credits (see L) or payments (see L). =cut @@ -391,8 +409,12 @@ sub delete { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with credits"; } + if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with payments"; + } - my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } ); + my @cust_pkg = $self->ncancelled_pkgs; if ( @cust_pkg ) { my $new_custnum = shift; unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { @@ -410,6 +432,15 @@ sub delete { } } } + my @cancelled_cust_pkg = $self->all_pkgs; + foreach my $cust_pkg ( @cancelled_cust_pkg ) { + my $error = $cust_pkg->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + foreach my $cust_main_invoice ( qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) ) { @@ -535,17 +566,19 @@ sub check { $self->ss("$1-$2-$3"); } - unless ( qsearchs('cust_main_county', { - 'country' => $self->country, - 'state' => '', - } ) ) { - return "Unknown state/county/country: ". - $self->state. "/". $self->county. "/". $self->country - unless qsearchs('cust_main_county',{ - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - } ); + unless ( $import ) { + unless ( qsearchs('cust_main_county', { + 'country' => $self->country, + 'state' => '', + } ) ) { + return "Unknown state/county/country: ". + $self->state. "/". $self->county. "/". $self->country + unless qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, + } ); + } } $error = @@ -685,7 +718,11 @@ Returns all packages (see L) for this customer. sub all_pkgs { my $self = shift; - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + if ( $self->{'_pkgnum'} ) { + values %{ $self->{'_pkgnum'}->cache }; + } else { + qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + } } =item ncancelled_pkgs @@ -696,16 +733,82 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; - @{ [ # force list context - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; + if ( $self->{'_pkgnum'} ) { + grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; + } else { + @{ [ # force list context + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => '', + }), + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => 0, + }), + ] }; + } +} + +=item suspended_pkgs + +Returns all suspended packages (see L) for this customer. + +=cut + +sub suspended_pkgs { + my $self = shift; + grep { $_->susp } $self->ncancelled_pkgs; +} + +=item unflagged_suspended_pkgs + +Returns all unflagged suspended packages (see L) for this +customer (thouse packages without the `manual_flag' set). + +=cut + +sub unflagged_suspended_pkgs { + my $self = shift; + return $self->suspended_pkgs + unless dbdef->table('cust_pkg')->column('manual_flag'); + grep { ! $_->manual_flag } $self->suspended_pkgs; +} + +=item unsuspended_pkgs + +Returns all unsuspended (and uncancelled) packages (see L) for +this customer. + +=cut + +sub unsuspended_pkgs { + my $self = shift; + grep { ! $_->susp } $self->ncancelled_pkgs; +} + +=item unsuspend + +Unsuspends all unflagged suspended packages (see L +and L) for this customer. Always returns a list: an empty list +on success or a list of errors. + +=cut + +sub unsuspend { + my $self = shift; + grep { $_->unsuspend } $self->suspended_pkgs; +} + +=item suspend + +Suspends all unsuspended packages (see L) for this customer. +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub suspend { + my $self = shift; + grep { $_->suspend } $self->unsuspended_pkgs; } =item bill OPTIONS @@ -750,12 +853,14 @@ sub bill { # & generate invoice database. my( $total_setup, $total_recur ) = ( 0, 0 ); + my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); my @cust_bill_pkg = (); foreach my $cust_pkg ( - qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } ) + qsearch('cust_pkg', { 'custnum' => $self->custnum } ) ) { + #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); #? to avoid use of uninitialized value errors... ? @@ -780,14 +885,15 @@ sub bill { }; $setup_prog = $1; - my $cpt = new Safe; - #$cpt->permit(); #what is necessary? - $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - $setup = $cpt->reval($setup_prog); + #my $cpt = new Safe; + ##$cpt->permit(); #what is necessary? + #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? + #$setup = $cpt->reval($setup_prog); + $setup = eval $setup_prog; unless ( defined($setup) ) { $dbh->rollback if $oldAutoCommit; - return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. - ": $@"; + return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. + "(expression $setup_prog): $@"; } $cust_pkg->setfield('setup',$time); $cust_pkg_mod_flag=1; @@ -808,14 +914,15 @@ sub bill { }; $recur_prog = $1; - my $cpt = new Safe; - #$cpt->permit(); #what is necessary? - $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - $recur = $cpt->reval($recur_prog); + #my $cpt = new Safe; + ##$cpt->permit(); #what is necessary? + #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? + #$recur = $cpt->reval($recur_prog); + $recur = eval $recur_prog; unless ( defined($recur) ) { $dbh->rollback if $oldAutoCommit; - return "Error reval-ing part_pkg->recur pkgpart ". - $part_pkg->pkgpart. ": $@"; + return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. + "(expression $recur_prog): $@"; } #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) @@ -862,37 +969,49 @@ sub bill { push @cust_bill_pkg, $cust_bill_pkg; $total_setup += $setup; $total_recur += $recur; + $taxable_setup += $setup + unless $part_pkg->dbdef_table->column('setuptax') + || $part_pkg->setuptax =~ /^Y$/i; + $taxable_recur += $recur + unless $part_pkg->dbdef_table->column('recurtax') + || $part_pkg->recurtax =~ /^Y$/i; } } } my $charged = sprintf( "%.2f", $total_setup + $total_recur ); + my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); unless ( @cust_bill_pkg ) { $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } - unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { + unless ( $self->tax =~ /Y/i + || $self->payby eq 'COMP' + || $taxable_charged == 0 ) { my $cust_main_county = qsearchs('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, } ); my $tax = sprintf( "%.2f", - $charged * ( $cust_main_county->getfield('tax') / 100 ) + $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) ); - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; + + if ( $tax > 0 ) { + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + }); + push @cust_bill_pkg, $cust_bill_pkg; + } } my $cust_bill = new FS::cust_bill ( { @@ -909,7 +1028,8 @@ sub bill { my $invnum = $cust_bill->invnum; my $cust_bill_pkg; foreach $cust_bill_pkg ( @cust_bill_pkg ) { - warn $cust_bill_pkg->invnum($invnum); + #warn $invnum; + $cust_bill_pkg->invnum($invnum); $error = $cust_bill_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1152,9 +1272,9 @@ sub collect { } my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceonly') ) { - @invoicing_list = $self->default_invoicing_list - unless @invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->default_invoicing_list; } my $email = $invoicing_list[0]; @@ -1297,10 +1417,25 @@ Returns the total owed for this customer on all invoices sub total_owed { my $self = shift; + $self->total_owed_date(2145859200); #12/31/2037 +} + +=item total_owed_date TIME + +Returns the total owed for this customer on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. + +=cut + +sub total_owed_date { + my $self = shift; + my $time = shift; my $total_bill = 0; - foreach my $cust_bill ( qsearch('cust_bill', { - 'custnum' => $self->custnum, - } ) ) { + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { $total_bill += $cust_bill->owed; } sprintf( "%.2f", $total_bill ); @@ -1403,7 +1538,7 @@ sub apply_payments { } - # return 0; + return $self->total_unapplied_payments; } =item total_credited @@ -1456,6 +1591,26 @@ sub balance { ); } +=item balance_date TIME + +Returns the balance for this customer, only considering invoices with date +earlier than TIME (total_owed_date minus total_credited minus +total_unapplied_payments). TIME is specified as a UNIX timestamp; see +L). Also see L and L for conversion +functions. + +=cut + +sub balance_date { + my $self = shift; + my $time = shift; + sprintf( "%.2f", + $self->total_owed_date($time) + - $self->total_credited + - $self->total_unapplied_payments + ); +} + =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -1495,15 +1650,17 @@ sub invoicing_list { } else { @cust_main_invoice = (); } + my %seen = map { $_->address => 1 } @cust_main_invoice; foreach my $address ( @{$arrayref} ) { - unless ( grep { $address eq $_->address } @cust_main_invoice ) { - my $cust_main_invoice = new FS::cust_main_invoice ( { - 'custnum' => $self->custnum, - 'dest' => $address, - } ); - my $error = $cust_main_invoice->insert; - warn $error if $error; - } + #unless ( grep { $address eq $_->address } @cust_main_invoice ) { + next if exists $seen{$address} && $seen{$address}; + $seen{$address} = 1; + my $cust_main_invoice = new FS::cust_main_invoice ( { + 'custnum' => $self->custnum, + 'dest' => $address, + } ); + my $error = $cust_main_invoice->insert; + warn $error if $error; } } if ( $self->custnum ) { @@ -1539,6 +1696,8 @@ sub check_invoicing_list { =item default_invoicing_list +Returns the email addresses of any + =cut sub default_invoicing_list { @@ -1583,6 +1742,63 @@ sub referral_cust_main { @cust_main; } +=item referral_cust_pkg [ DEPTH ] + +Like referral_cust_main, except returns a flat list of all unsuspended packages +for each customer. The number of items in this list may be useful for +comission calculations (perhaps after a grep). + +=cut + +sub referral_cust_pkg { + my $self = shift; + my $depth = @_ ? shift : 1; + + map { $_->unsuspended_pkgs } + grep { $_->unsuspended_pkgs } + $self->referral_cust_main($depth); +} + +=item credit AMOUNT, REASON + +Applies a credit to this customer. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub credit { + my( $self, $amount, $reason ) = @_; + my $cust_credit = new FS::cust_credit { + 'custnum' => $self->custnum, + 'amount' => $amount, + 'reason' => $reason, + }; + $cust_credit->insert; +} + +=item charge AMOUNT PKG COMMENT + +Creates a one-time charge for this customer. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub charge { + my ( $self, $amount, $pkg, $comment ) = @_; + + my $part_pkg = new FS::part_pkg ( { + 'pkg' => $pkg || 'One-time charge', + 'comment' => $comment, + 'setup' => $amount, + 'freq' => 0, + 'recur' => '0', + 'disabled' => 'Y', + } ); + + $part_pkg->insert; + +} + =back =head1 SUBROUTINES @@ -1724,7 +1940,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.38 2001-09-26 09:17:06 ivan Exp $ +$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $ =head1 BUGS