X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=6c18f93a1cf41bac23bfb91a1f0fab0b56f4e591;hb=5e25b996982d42eb2587ec54db0d5b39508aa730;hp=dce73c0bac9d1c9e96f1a3e974c5369b9fd7b6a7;hpb=a984fa561b6493ae41215c3d26013767f9ce79cb;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index dce73c0ba..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 @@ -362,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 @@ -392,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 } ) ) { @@ -411,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 } ) ) { @@ -536,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 = @@ -686,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 @@ -697,16 +733,20 @@ 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 @@ -813,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... ? @@ -850,8 +892,8 @@ sub bill { $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; @@ -879,8 +921,8 @@ sub bill { $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) @@ -927,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 ( { @@ -974,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; @@ -1362,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 ); @@ -1521,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 @@ -1686,6 +1776,29 @@ sub credit { $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 @@ -1827,7 +1940,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.41 2001-10-15 12:16:42 ivan Exp $ +$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $ =head1 BUGS