X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=445c6951a0e4e5c776ba35af445ef33b88196663;hp=0b37a351e59de11c65fb351b5f5066d43bcd0b61;hb=98a73bb080f55f4f5d850102bcec6da2807e3d4f;hpb=b55c616066a2eabf78f2195572d52440e5669a3c diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0b37a351e..445c6951a 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,16 +1,12 @@ 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); +use vars qw( @ISA $conf $Debug $import ); use Safe; use Carp; use Time::Local; use Date::Format; #use Date::Manip; -use Mail::Internet; -use Mail::Header; use Business::CreditCard; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); @@ -19,7 +15,6 @@ use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; use FS::cust_credit; -use FS::cust_pay_batch; use FS::part_referral; use FS::cust_main_county; use FS::agent; @@ -28,53 +23,36 @@ use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; +use FS::part_pkg; +use FS::part_bill_event; +use FS::cust_bill_event; +use FS::Msgcat qw(gettext); @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; - $lpr = $conf->config('lpr'); - $invoice_from = $conf->config('invoice_from'); - $smtpmachine = $conf->config('smtpmachine'); - - if ( $conf->exists('cybercash3.2') ) { - require CCMckLib3_2; - #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2); - require CCMckDirectLib3_2; - #qw(SendCC2_1Server); - require CCMckErrno3_2; - #qw(MCKGetErrorMessage $E_NoErr); - import CCMckErrno3_2 qw($E_NoErr); - - my $merchant_conf; - ($merchant_conf,$xaction)= $conf->config('cybercash3.2'); - my $status = &CCMckLib3_2::InitConfig($merchant_conf); - if ( $status != $E_NoErr ) { - warn "CCMckLib3_2::InitConfig error:\n"; - foreach my $key (keys %CCMckLib3_2::Config) { - warn " $key => $CCMckLib3_2::Config{$key}\n" - } - my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status); - die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; - } - $processor='cybercash3.2'; - } elsif ( $conf->exists('business-onlinepayment') ) { - ( $bop_processor, - $bop_login, - $bop_password, - $bop_action, - @bop_options - ) = $conf->config('business-onlinepayment'); - $bop_action ||= 'normal authorization'; - eval "use Business::OnlinePayment"; - $processor="Business::OnlinePayment::$bop_processor"; - } + #yes, need it for stuff below (prolly should be cached) }; +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 +76,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; @@ -120,7 +100,7 @@ FS::Record. The following fields are currently supported: =item agentnum - agent (see L) -=item refnum - referral (see L) +=item refnum - Advertising source (see L) =item first - name @@ -214,10 +194,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 +210,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' ] ); @@ -331,6 +310,7 @@ sub insert { } } + #false laziness with sub replace my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; $error = $queue->insert($self->getfield('last'), $self->company); if ( $error ) { @@ -346,6 +326,7 @@ sub insert { return "queueing job (transaction rolled back): $error"; } } + #eslaf $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -361,11 +342,14 @@ 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), payments (see L) or +refunds (see L). =cut @@ -391,8 +375,16 @@ 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"; + } + if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with refunds"; + } - 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,7 +402,16 @@ sub delete { } } } - foreach my $cust_main_invoice ( + 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 ( #(email invoice destinations, not invoices) qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) ) { my $error = $cust_main_invoice->delete; @@ -478,6 +479,24 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + #false laziness with sub insert + my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; + $error = $queue->insert($self->getfield('last'), $self->company); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { + $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; + $error = $queue->insert($self->getfield('last'), $self->company); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + #eslaf + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -494,6 +513,8 @@ and repalce methods. sub check { my $self = shift; + #warn "BEFORE: \n". $self->_dump; + my $error = $self->ut_numbern('custnum') || $self->ut_number('agentnum') @@ -511,14 +532,14 @@ sub check { || $self->ut_numbern('referral_custnum') ; #barf. need message catalogs. i18n. etc. - $error .= "Please select a referral." + $error .= "Please select a advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; return "Unknown agent" unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); - return "Unknown referral" + return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); return "Unknown referring custnum ". $self->referral_custnum @@ -535,18 +556,22 @@ 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, - } ); - } + +# bad idea to disable, causes billing to fail because of no tax rates later +# 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 = $self->ut_phonen('daytime', $self->country) @@ -562,8 +587,9 @@ sub check { ); if ( defined $self->dbdef_table->column('ship_last') ) { - if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields - && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields + if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } + @addfields ) + && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields ) ) { my $error = @@ -618,12 +644,13 @@ sub check { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; $payinfo =~ /^(\d{13,16})$/ - or return "Illegal credit card number: ". $self->payinfo; + or return gettext('invalid_card'); # . ": ". $self->payinfo; $payinfo = $1; $self->payinfo($payinfo); validate($payinfo) - or return "Illegal credit card number: ". $self->payinfo; - return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; + or return gettext('invalid_card'); # . ": ". $self->payinfo; + return gettext('unknown_card_type') + if cardtype($self->payinfo) eq "Unknown"; } elsif ( $self->payby eq 'BILL' ) { @@ -665,7 +692,7 @@ sub check { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\']+)$/ - or return "Illegal billing name: ". $self->payname; + or return gettext('illegal_name'). " payname: ". $self->payname; $self->payname($1); } @@ -674,6 +701,8 @@ sub check { $self->otaker(getotaker); + #warn "AFTER: \n". $self->_dump; + ''; #no error } @@ -685,7 +714,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 +729,105 @@ 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 cancel + +Cancels all uncancelled packages (see L) for this customer. +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub cancel { + my $self = shift; + grep { $_->cancel } $self->ncancelled_pkgs; +} + +=item agent + +Returns the agent (see L) for this customer. + +=cut + +sub agent { + my $self = shift; + qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } =item bill OPTIONS @@ -750,12 +872,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 +904,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,22 +933,29 @@ 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); + # shared with $recur_prog + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + + #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) - #$sdate=$cust_pkg->bill || time; - #$sdate=$cust_pkg->bill || $time; - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; + + #pro-rating magic - if $recur_prog fiddles $sdate, want to use that + # only for figuring next bill date, nothing else, so, reset $sdate again + # here + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + $mon += $part_pkg->getfield('freq'); until ( $mon < 12 ) { $mon -= 12; $year++; } $cust_pkg->setfield('bill', @@ -862,37 +994,50 @@ 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, - } ); + } ) or die "fatal: can't find tax rate for state/county/country ". + $self->state. "/". $self->county. "/". $self->country. "\n"; 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 +1054,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; @@ -930,6 +1076,9 @@ L). Usually used after the bill method. Depending on the value of `payby', this may print an invoice (`BILL'), charge a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP'). +Most actions are now triggered by invoice events; see L +and the invoice events web interface. + If there is an error, returns the error, otherwise returns false. Options are passed as name-value pairs. @@ -940,12 +1089,12 @@ invoice_time - Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L). Also see L and L for conversion functions. -batch_card - Set this true to batch cards (see L). By -default, cards are processed immediately, which will generate an error if -CyberCash is not installed. +batch_card - This option is deprecated. See the invoice events web interface +to control whether cards are batched or run against a realtime gateway. + +report_badcard - This option is deprecated. -report_badcard - Set this true if you want bad card transactions to -return an error. By default, they don't. +force_print - This option is deprecated; see the invoice events web interface. =cut @@ -966,7 +1115,7 @@ sub collect { my $dbh = dbh; my $balance = $self->balance; - warn "collect: balance $balance" if $Debug; + warn "collect customer". $self->custnum. ": balance $balance" if $Debug; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -986,260 +1135,74 @@ sub collect { next unless $cust_bill->owed > 0; # don't try to charge for the same invoice if it's already in a batch - next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); + #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug; next unless $amount > 0; - if ( $self->payby eq 'BILL' ) { - - #30 days 2592000 - my $since = $invoice_time - ( $cust_bill->_date || 0 ); - #warn "$invoice_time ", $cust_bill->_date, " $since"; - if ( $since >= 0 #don't print future invoices - && ( $cust_bill->printed * 2592000 ) <= $since - ) { - - #my @print_text = $cust_bill->print_text; #( date ) - my @invoicing_list = $self->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice - $ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $invoice_from; - my $header = new Mail::Header ( [ - "From: $invoice_from", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $invoice_from", - "Reply-To: $invoice_from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Invoice", - ] ); - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ $cust_bill->print_text ], #( date) - ); - $message->smtpsend or die "Can't send invoice email!"; #die? warn? - - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { - open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!"; - print LPR $cust_bill->print_text; #( date ) - close LPR - or die $! ? "Error closing $lpr: $!" - : "Exit status $? from $lpr"; - } - - my %hash = $cust_bill->hash; - $hash{'printed'}++; - my $new_cust_bill = new FS::cust_bill(\%hash); - my $error = $new_cust_bill->replace($cust_bill); - warn "Error updating $cust_bill->printed: $error" if $error; + foreach my $part_bill_event ( + sort { $a->seconds <=> $b->seconds + || $a->weight <=> $b->weight + || $a->eventpart <=> $b->eventpart } + grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) + && ! qsearchs( 'cust_bill_event', { + 'invnum' => $cust_bill->invnum, + 'eventpart' => $_->eventpart, + 'status' => 'done', + } ) + } + qsearch('part_bill_event', { 'payby' => $self->payby, + 'disabled' => '', } ) + ) { + last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0 + + warn "calling invoice event (". $part_bill_event->eventcode. ")\n" + if $Debug; + my $cust_main = $self; #for callback + my $error = eval $part_bill_event->eventcode; + + my $status = ''; + my $statustext = ''; + if ( $@ ) { + $status = 'failed'; + $statustext = $@; + } elsif ( $error ) { + $status = 'done'; + $statustext = $error; + } else { + $status = 'done' } - } elsif ( $self->payby eq 'COMP' ) { - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $cust_bill->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'COMP', - 'payinfo' => $self->payinfo, - 'paybatch' => '' - } ); - my $error = $cust_pay->insert; + #add cust_bill_event + my $cust_bill_event = new FS::cust_bill_event { + 'invnum' => $cust_bill->invnum, + 'eventpart' => $part_bill_event->eventpart, + '_date' => $invoice_time, + 'status' => $status, + 'statustext' => $statustext, + }; + $error = $cust_bill_event->insert; if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error"; + #$dbh->rollback if $oldAutoCommit; + #return "error: $error"; + + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + my $e = 'WARNING: Event run but database not updated - '. + 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum. + ', eventpart '. $part_bill_event->eventpart. + ": $error"; + warn $e; + return $e; } - } elsif ( $self->payby eq 'CARD' ) { - - if ( $options{'batch_card'} ne 'yes' ) { - - unless ( $processor ) { - $dbh->rollback if $oldAutoCommit; - return "Real time card processing not enabled!"; - } - - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - - #fix exp. date - #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - my $exp = "$2/$1"; - - if ( $processor eq 'cybercash3.2' ) { - - #fix exp. date for cybercash - #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - my $exp = "$2/$1"; - - my $paybatch = $cust_bill->invnum. - '-' . time2str("%y%m%d%H%M%S", time); - - my $payname = $self->payname || - $self->getfield('first'). ' '. $self->getfield('last'); - - - my $country = $self->country eq 'US' ? 'USA' : $self->country; - - my @full_xaction = ( $xaction, - 'Order-ID' => $paybatch, - 'Amount' => "usd $amount", - 'Card-Number' => $self->getfield('payinfo'), - 'Card-Name' => $payname, - 'Card-Address' => $address, - 'Card-City' => $self->getfield('city'), - 'Card-State' => $self->getfield('state'), - 'Card-Zip' => $self->getfield('zip'), - 'Card-Country' => $country, - 'Card-Exp' => $exp, - ); - - my %result; - %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); - - #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3 - #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1 - if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $cust_bill->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'CARD', - 'payinfo' => $self->payinfo, - 'paybatch' => "$processor:$paybatch", - } ); - my $error = $cust_pay->insert; - if ( $error ) { - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Card debited but database not updated - '. - 'error applying payment, invnum #' . $cust_bill->invnum. - " (CyberCash Order-ID $paybatch): $error"; - warn $e; - return $e; - } - } elsif ( $result{'Mstatus'} ne 'failure-bad-money' - || $options{'report_badcard'} ) { - $dbh->commit if $oldAutoCommit; - return 'Cybercash error, invnum #' . - $cust_bill->invnum. ':'. $result{'MErrMsg'}; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - } - - } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) { - - my $bop_processor = $1; - - my($payname, $payfirst, $paylast); - if ( $self->payname ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/ - or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal payname $payname"; - }; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('first'); - $payname = "$payfirst $paylast"; - } - - my $transaction = - new Business::OnlinePayment( $bop_processor, @bop_options ); - $transaction->content( - 'type' => 'CC', - 'login' => $bop_login, - 'password' => $bop_password, - 'action' => $bop_action, - 'amount' => $amount, - 'invoice_number' => $cust_bill->invnum, - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, - 'card_number' => $self->payinfo, - 'expiration' => $exp, - ); - $transaction->submit(); - - if ( $transaction->is_success()) { - my $cust_pay = new FS::cust_pay ( { - 'invnum' => $cust_bill->invnum, - 'paid' => $amount, - '_date' => '', - 'payby' => 'CARD', - 'payinfo' => $self->payinfo, - 'paybatch' => "$processor:". $transaction->authorization, - } ); - my $error = $cust_pay->insert; - if ( $error ) { - # gah, even with transactions. - $dbh->commit if $oldAutoCommit; #well. - my $e = 'WARNING: Card debited but database not updated - '. - 'error applying payment, invnum #' . $cust_bill->invnum. - " ($processor): $error"; - warn $e; - return $e; - } - } elsif ( $options{'report_badcard'} ) { - $dbh->commit if $oldAutoCommit; - return "$processor error, invnum #". $cust_bill->invnum. ': '. - $transaction->result_code. ": ". $transaction->error_message; - } else { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #return ''; - } - - } else { - $dbh->rollback if $oldAutoCommit; - return "Unknown real-time processor $processor\n"; - } - - } else { #batch card - - my $cust_pay_batch = new FS::cust_pay_batch ( { - 'invnum' => $cust_bill->getfield('invnum'), - 'custnum' => $self->getfield('custnum'), - 'last' => $self->getfield('last'), - 'first' => $self->getfield('first'), - 'address1' => $self->getfield('address1'), - 'address2' => $self->getfield('address2'), - 'city' => $self->getfield('city'), - 'state' => $self->getfield('state'), - 'zip' => $self->getfield('zip'), - 'country' => $self->getfield('country'), - 'trancode' => 77, - 'cardnum' => $self->getfield('payinfo'), - 'exp' => $self->getfield('paydate'), - 'payname' => $self->getfield('payname'), - 'amount' => $amount, - } ); - my $error = $cust_pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error adding to cust_pay_batch: $error"; - } - - } - - } else { - $dbh->rollback if $oldAutoCommit; - return "Unknown payment type ". $self->payby; } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1254,10 +1217,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 ); @@ -1360,7 +1338,7 @@ sub apply_payments { } - # return 0; + return $self->total_unapplied_payments; } =item total_credited @@ -1413,6 +1391,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 @@ -1452,15 +1450,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 ) { @@ -1494,6 +1494,41 @@ sub check_invoicing_list { ''; } +=item default_invoicing_list + +Sets the invoicing list to all accounts associated with this customer. + +=cut + +sub default_invoicing_list { + my $self = shift; + my @list = (); + foreach my $cust_pkg ( $self->all_pkgs ) { + my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); + my @svc_acct = + map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + @cust_svc; + push @list, map { $_->email } @svc_acct; + } + $self->invoicing_list(\@list); +} + +=item invoicing_list_addpost + +Adds postal invoicing to this customer. If this customer is already configured +to receive postal invoices, does nothing. + +=cut + +sub invoicing_list_addpost { + my $self = shift; + return if grep { $_ eq 'POST' } $self->invoicing_list; + my @invoicing_list = $self->invoicing_list; + push @invoicing_list, 'POST'; + $self->invoicing_list(\@invoicing_list); +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -1522,6 +1557,75 @@ sub referral_cust_main { @cust_main; } +=item referral_cust_main_ncancelled + +Same as referral_cust_main, except only returns customers with uncancelled +packages. + +=cut + +sub referral_cust_main_ncancelled { + my $self = shift; + grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main; +} + +=item referral_cust_pkg [ DEPTH ] + +Like referral_cust_main, except returns a flat list of all unsuspended (and +uncancelled) packages for each customer. The number of items in this list may +be useful for comission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). + +=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 || '$'. sprintf("%.2f".$amount), + 'setup' => $amount, + 'freq' => 0, + 'recur' => '0', + 'disabled' => 'Y', + } ); + + $part_pkg->insert; + +} + =back =head1 SUBROUTINES @@ -1598,7 +1702,7 @@ sub all_last { my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; open(LASTCACHE,"<$dir/cust_main.last") or die "can't open $dir/cust_main.last: $!"; - my @array = split(/\n/, ); + my @array = map { chomp; $_; } ; close LASTCACHE; \@array; } @@ -1611,7 +1715,7 @@ sub all_company { my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; open(COMPANYCACHE,"<$dir/cust_main.company") or die "can't open $dir/cust_main.last: $!"; - my @array = split(/\n/, ); + my @array = map { chomp; $_; } ; close COMPANYCACHE; \@array; } @@ -1661,9 +1765,7 @@ sub append_fuzzyfiles { 1; } -=head1 VERSION - -$Id: cust_main.pm,v 1.32 2001-09-11 12:10:56 ivan Exp $ +=back =head1 BUGS @@ -1675,8 +1777,6 @@ instead of a scalar customer number. Bill and collect options should probably be passed as references instead of a list. -CyberCash v2 forces us to define some variables in package main. - There should probably be a configuration file with a list of allowed credit card types. @@ -1685,9 +1785,8 @@ No multiple currency support (probably a larger project than just this module). =head1 SEE ALSO L, L, L, L -L, L, L, -L, L, -L, schema.html from the base documentation. +L, L, L, +L, L, schema.html from the base documentation. =cut