@cust_pkg = $record->ncancelled_pkgs;
+ @cust_pkg = $record->suspended_pkgs;
+
$error = $record->bill;
$error = $record->bill %options;
$error = $record->bill 'time' => $time;
CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
method containing FS::cust_pkg and FS::svc_I<tablename> 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
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' ] );
] };
}
+=item suspended_pkgs
+
+Returns all suspended packages (see L<FS::cust_pkg>) 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<FS::cust_pkg>) 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<FS::cust_pkg>) for
+this customer.
+
+=cut
+
+sub unsuspended_pkgs {
+ my $self = shift;
+ grep { ! $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unsuspend
+
+Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
+and L<FS::cust_pkg>) 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<FS::cust_pkg>) 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<FS::cust_bill>) for this customer. Usually used in
# & 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 (
};
$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.
};
$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 ".
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 ( {
late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
for conversion functions.
-batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
+batch_card - Set this true to batch cards (see L<FS::cust_pay_batch>). By
default, cards are processed immediately, which will generate an error if
CyberCash is not installed.
$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 =
'card_number' => $self->payinfo,
'expiration' => $exp,
'referer' => 'http://cleanwhisker.420.am/',
+ 'email' => $email,
);
$transaction->submit();
}
- # return 0;
+ return $self->total_unapplied_payments;
}
=item total_credited
} 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 ) {
'';
}
+=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
@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
=head1 VERSION
-$Id: cust_main.pm,v 1.35 2001-09-25 15:55:48 ivan Exp $
+$Id: cust_main.pm,v 1.42 2001-10-20 12:17:59 ivan Exp $
=head1 BUGS
projects / freeside.git / blobdiff