X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=dce73c0bac9d1c9e96f1a3e974c5369b9fd7b6a7;hp=d66d08cb95719d666d9ee0f996970d6487cf12d6;hb=a984fa561b6493ae41215c3d26013767f9ce79cb;hpb=aadba4ddbf1a821d5523fdce4500b59b529aeee3 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index d66d08cb9..dce73c0ba 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -98,6 +98,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 +216,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 +232,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' ] ); @@ -708,6 +709,68 @@ sub ncancelled_pkgs { ] }; } +=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 Generates invoices (see L) for this customer. Usually used in @@ -780,10 +843,11 @@ 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. @@ -808,10 +872,11 @@ 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 ". @@ -940,7 +1005,7 @@ 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 +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. @@ -1151,6 +1216,13 @@ sub collect { $payname = "$payfirst $paylast"; } + my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->default_invoicing_list; + } + my $email = $invoicing_list[0]; + my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action ); my $transaction = @@ -1175,6 +1247,7 @@ sub collect { 'card_number' => $self->payinfo, 'expiration' => $exp, 'referer' => 'http://cleanwhisker.420.am/', + 'email' => $email, ); $transaction->submit(); @@ -1395,7 +1468,7 @@ sub apply_payments { } - # return 0; + return $self->total_unapplied_payments; } =item total_credited @@ -1487,15 +1560,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 ) { @@ -1529,6 +1604,26 @@ sub check_invoicing_list { ''; } +=item default_invoicing_list + +Returns the email addresses of any + +=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 referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -1557,6 +1652,40 @@ 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; +} + =back =head1 SUBROUTINES @@ -1698,7 +1827,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.35 2001-09-25 15:55:48 ivan Exp $ +$Id: cust_main.pm,v 1.41 2001-10-15 12:16:42 ivan Exp $ =head1 BUGS