-=item apply_payments_and_credits [ OPTION => VALUE ... ]
-
-Applies unapplied payments and credits.
-
-In most cases, this new method should be used in place of sequential
-apply_payments and apply_credits methods.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub apply_payments_and_credits {
- my( $self, %options ) = @_;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- $self->select_for_update; #mutex
-
- foreach my $cust_bill ( $self->open_cust_bill ) {
- my $error = $cust_bill->apply_payments_and_credits(%options);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error applying: $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-=item apply_credits OPTION => VALUE ...
-
-Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
-to outstanding invoice balances in chronological order (or reverse
-chronological order if the I<order> option is set to B<newest>) and returns the
-value of any remaining unapplied credits available for refund (see
-L<FS::cust_refund>).
-
-Dies if there is an error.
-
-=cut
-
-sub apply_credits {
- my $self = shift;
- my %opt = @_;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- $self->select_for_update; #mutex
-
- unless ( $self->total_unapplied_credits ) {
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return 0;
- }
-
- my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
- qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
-
- my @invoices = $self->open_cust_bill;
- @invoices = sort { $b->_date <=> $a->_date } @invoices
- if defined($opt{'order'}) && $opt{'order'} eq 'newest';
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @credits to those w/ a pkgnum grepped from $self
- my %pkgnums = ();
- foreach my $i (@invoices) {
- foreach my $li ( $i->cust_bill_pkg ) {
- $pkgnums{$li->pkgnum} = 1;
- }
- }
- @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
- }
-
- my $credit;
-
- foreach my $cust_bill ( @invoices ) {
-
- if ( !defined($credit) || $credit->credited == 0) {
- $credit = pop @credits or last;
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
- $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
- } else {
- $owed = $cust_bill->owed;
- }
- unless ( $owed > 0 ) {
- push @credits, $credit;
- next;
- }
-
- my $amount = min( $credit->credited, $owed );
-
- my $cust_credit_bill = new FS::cust_credit_bill ( {
- 'crednum' => $credit->crednum,
- 'invnum' => $cust_bill->invnum,
- 'amount' => $amount,
- } );
- $cust_credit_bill->pkgnum( $credit->pkgnum )
- if $conf->exists('pkg-balances') && $credit->pkgnum;
- my $error = $cust_credit_bill->insert;
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
-
- redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
-
- }
-
- my $total_unapplied_credits = $self->total_unapplied_credits;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return $total_unapplied_credits;
-}
-
-=item apply_payments [ OPTION => VALUE ... ]
-
-Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
-to outstanding invoice balances in chronological order.
-
- #and returns the value of any remaining unapplied payments.
-
-A hash of optional arguments may be passed. Currently "manual" is supported.
-If true, a payment receipt is sent instead of a statement when
-'payment_receipt_email' configuration option is set.
-
-Dies if there is an error.
-
-=cut
-
-sub apply_payments {
- my( $self, %options ) = @_;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- $self->select_for_update; #mutex
-
- #return 0 unless
-
- my @payments = sort { $b->_date <=> $a->_date }
- grep { $_->unapplied > 0 }
- $self->cust_pay;
-
- my @invoices = sort { $a->_date <=> $b->_date}
- grep { $_->owed > 0 }
- $self->cust_bill;
-
- if ( $conf->exists('pkg-balances') ) {
- # limit @payments to those w/ a pkgnum grepped from $self
- my %pkgnums = ();
- foreach my $i (@invoices) {
- foreach my $li ( $i->cust_bill_pkg ) {
- $pkgnums{$li->pkgnum} = 1;
- }
- }
- @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
- }
-
- my $payment;
-
- foreach my $cust_bill ( @invoices ) {
-
- if ( !defined($payment) || $payment->unapplied == 0 ) {
- $payment = pop @payments or last;
- }
-
- my $owed;
- if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
- $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
- } else {
- $owed = $cust_bill->owed;
- }
- unless ( $owed > 0 ) {
- push @payments, $payment;
- next;
- }
-
- my $amount = min( $payment->unapplied, $owed );
-
- my $cust_bill_pay = new FS::cust_bill_pay ( {
- 'paynum' => $payment->paynum,
- 'invnum' => $cust_bill->invnum,
- 'amount' => $amount,
- } );
- $cust_bill_pay->pkgnum( $payment->pkgnum )
- if $conf->exists('pkg-balances') && $payment->pkgnum;
- my $error = $cust_bill_pay->insert(%options);
- if ( $error ) {
- $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
- die $error;
- }
-
- redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
-
- }
-
- my $total_unapplied_payments = $self->total_unapplied_payments;
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
- return $total_unapplied_payments;
-}
-
-=item total_owed
-
-Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill/owed>).
-
-=cut
-
-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<perlfunc/"time">). Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub total_owed_date {
- my $self = shift;
- my $time = shift;
-
- my $custnum = $self->custnum;
-
- my $owed_sql = FS::cust_bill->owed_sql;
-
- my $sql = "
- SELECT SUM($owed_sql) FROM cust_bill
- WHERE custnum = $custnum
- AND _date <= $time
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) );
-
-}
-
-=item total_owed_pkgnum PKGNUM
-
-Returns the total owed on all invoices for this customer's specific package
-when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
-
-=cut
-
-sub total_owed_pkgnum {
- my( $self, $pkgnum ) = @_;
- $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
-}
-
-=item total_owed_date_pkgnum TIME PKGNUM
-
-Returns the total owed for this customer's specific package when using
-experimental package balances on all invoices with date earlier than
-TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub total_owed_date_pkgnum {
- my( $self, $time, $pkgnum ) = @_;
-
- my $total_bill = 0;
- foreach my $cust_bill (
- grep { $_->_date <= $time }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
- $total_bill += $cust_bill->owed_pkgnum($pkgnum);
- }
- sprintf( "%.2f", $total_bill );
-
-}
-
-=item total_paid
-
-Returns the total amount of all payments.
-
-=cut
-
-sub total_paid {
- my $self = shift;
- my $total = 0;
- $total += $_->paid foreach $self->cust_pay;
- sprintf( "%.2f", $total );
-}
-
-=item total_unapplied_credits
-
-Returns the total outstanding credit (see L<FS::cust_credit>) for this
-customer. See L<FS::cust_credit/credited>.
-
-=item total_credited
-
-Old name for total_unapplied_credits. Don't use.
-
-=cut
-
-sub total_credited {
- #carp "total_credited deprecated, use total_unapplied_credits";
- shift->total_unapplied_credits(@_);
-}
-
-sub total_unapplied_credits {
- my $self = shift;
-
- my $custnum = $self->custnum;
-
- my $unapplied_sql = FS::cust_credit->unapplied_sql;
-
- my $sql = "
- SELECT SUM($unapplied_sql) FROM cust_credit
- WHERE custnum = $custnum
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) );
-
-}
-
-=item total_unapplied_credits_pkgnum PKGNUM
-
-Returns the total outstanding credit (see L<FS::cust_credit>) for this
-customer. See L<FS::cust_credit/credited>.
-
-=cut
-
-sub total_unapplied_credits_pkgnum {
- my( $self, $pkgnum ) = @_;
- my $total_credit = 0;
- $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
- sprintf( "%.2f", $total_credit );
-}
-
-
-=item total_unapplied_payments
-
-Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
-See L<FS::cust_pay/unapplied>.
-
-=cut
-
-sub total_unapplied_payments {
- my $self = shift;
-
- my $custnum = $self->custnum;
-
- my $unapplied_sql = FS::cust_pay->unapplied_sql;
-
- my $sql = "
- SELECT SUM($unapplied_sql) FROM cust_pay
- WHERE custnum = $custnum
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) );
-
-}
-
-=item total_unapplied_payments_pkgnum PKGNUM
-
-Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
-specific package when using experimental package balances. See
-L<FS::cust_pay/unapplied>.
-
-=cut
-
-sub total_unapplied_payments_pkgnum {
- my( $self, $pkgnum ) = @_;
- my $total_unapplied = 0;
- $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
- sprintf( "%.2f", $total_unapplied );
-}
-
-
-=item total_unapplied_refunds
-
-Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
-customer. See L<FS::cust_refund/unapplied>.
-
-=cut
-
-sub total_unapplied_refunds {
- my $self = shift;
- my $custnum = $self->custnum;
-
- my $unapplied_sql = FS::cust_refund->unapplied_sql;
-
- my $sql = "
- SELECT SUM($unapplied_sql) FROM cust_refund
- WHERE custnum = $custnum
- ";
-
- sprintf( "%.2f", $self->scalar_sql($sql) );
-
-}
-
-=item balance
-
-Returns the balance for this customer (total_owed plus total_unrefunded, minus
-total_unapplied_credits minus total_unapplied_payments).
-
-=cut
-
-sub balance {
- my $self = shift;
- $self->balance_date_range;
-}
-
-=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<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-sub balance_date {
- my $self = shift;
- $self->balance_date_range(shift);
-}
-
-=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
-
-Returns the balance for this customer, optionally considering invoices with
-date earlier than START_TIME, and not later than END_TIME
-(total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
-
-Times are specified as SQL fragments or numeric
-UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. The empty string can be passed
-to disable that time constraint completely.
-
-Available options are:
-
-=over 4
-
-=item unapplied_date
-
-set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
-
-=back
-
-=cut
-
-sub balance_date_range {
- my $self = shift;
- my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
- ') FROM cust_main WHERE custnum='. $self->custnum;
- sprintf( '%.2f', $self->scalar_sql($sql) );
-}
-
-=item balance_pkgnum PKGNUM
-
-Returns the balance for this customer's specific package when using
-experimental package balances (total_owed plus total_unrefunded, minus
-total_unapplied_credits minus total_unapplied_payments)
-
-=cut
-
-sub balance_pkgnum {
- my( $self, $pkgnum ) = @_;
-
- sprintf( "%.2f",
- $self->total_owed_pkgnum($pkgnum)
-# n/a - refunds aren't part of pkg-balances since they don't apply to invoices
-# + $self->total_unapplied_refunds_pkgnum($pkgnum)
- - $self->total_unapplied_credits_pkgnum($pkgnum)
- - $self->total_unapplied_payments_pkgnum($pkgnum)
- );
-}
-
-=item in_transit_payments
-
-Returns the total of requests for payments for this customer pending in
-batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
-
-=cut
-
-sub in_transit_payments {
- my $self = shift;
- my $in_transit_payments = 0;
- foreach my $pay_batch ( qsearch('pay_batch', {
- 'status' => 'I',
- } ) ) {
- foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
- 'batchnum' => $pay_batch->batchnum,
- 'custnum' => $self->custnum,
- } ) ) {
- $in_transit_payments += $cust_pay_batch->amount;
- }
- }
- sprintf( "%.2f", $in_transit_payments );
-}
-
-=item payment_info
-
-Returns a hash of useful information for making a payment.
-
-=over 4
-
-=item balance
-
-Current balance.
-
-=item payby
-
-'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
-'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
-'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
-
-=back
-
-For credit card transactions:
-
-=over 4
-
-=item card_type 1
-
-=item payname
-
-Exact name on card
-
-=back
-
-For electronic check transactions:
-
-=over 4
-
-=item stateid_state
-
-=back
-
-=cut
-
-sub payment_info {
- my $self = shift;
-
- my %return = ();
-
- $return{balance} = $self->balance;
-
- $return{payname} = $self->payname
- || ( $self->first. ' '. $self->get('last') );
-
- $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
-
- $return{payby} = $self->payby;
- $return{stateid_state} = $self->stateid_state;
-
- if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
- $return{card_type} = cardtype($self->payinfo);
- $return{payinfo} = $self->paymask;
-
- @return{'month', 'year'} = $self->paydate_monthyear;
-
- }
-
- if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
- my ($payinfo1, $payinfo2) = split '@', $self->paymask;
- $return{payinfo1} = $payinfo1;
- $return{payinfo2} = $payinfo2;
- $return{paytype} = $self->paytype;
- $return{paystate} = $self->paystate;
-
- }
-
- #doubleclick protection
- my $_date = time;
- $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
-
- %return;
-
-}
-
-=item paydate_monthyear
-
-Returns a two-element list consisting of the month and year of this customer's
-paydate (credit card expiration date for CARD customers)
-
-=cut
-
-sub paydate_monthyear {
- my $self = shift;
- if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
- ( $2, $1 );
- } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
- ( $1, $3 );
- } else {
- ('', '');
- }
-}
-
-=item tax_exemption TAXNAME
-
-=cut
-
-sub tax_exemption {
- my( $self, $taxname ) = @_;
-
- qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
- 'taxname' => $taxname,
- },
- );
-}
-
-=item cust_main_exemption
-
-=cut
-
-sub cust_main_exemption {
- my $self = shift;
- qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
-}
-
-=item invoicing_list [ ARRAYREF ]
-
-If an arguement is given, sets these email addresses as invoice recipients
-(see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
-(except as warnings), so use check_invoicing_list first.
-
-Returns a list of email addresses (with svcnum entries expanded).
-
-Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
-check it without disturbing anything by passing nothing.
-
-This interface may change in the future.
-
-=cut
-
-sub invoicing_list {
- my( $self, $arrayref ) = @_;
-
- if ( $arrayref ) {
- my @cust_main_invoice;
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- foreach my $cust_main_invoice ( @cust_main_invoice ) {
- #warn $cust_main_invoice->destnum;
- unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
- #warn $cust_main_invoice->destnum;
- my $error = $cust_main_invoice->delete;
- warn $error if $error;
- }
- }
- if ( $self->custnum ) {
- @cust_main_invoice =
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- @cust_main_invoice = ();
- }
- my %seen = map { $_->address => 1 } @cust_main_invoice;
- foreach my $address ( @{$arrayref} ) {
- 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 ) {
- map { $_->address }
- qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
- } else {
- ();
- }
-
-}
-
-=item check_invoicing_list ARRAYREF
-
-Checks these arguements as valid input for the invoicing_list method. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub check_invoicing_list {
- my( $self, $arrayref ) = @_;
-
- foreach my $address ( @$arrayref ) {
-
- if ($address eq 'FAX' and $self->getfield('fax') eq '') {
- return 'Can\'t add FAX invoice destination with a blank FAX number.';
- }
-
- my $cust_main_invoice = new FS::cust_main_invoice ( {
- 'custnum' => $self->custnum,
- 'dest' => $address,
- } );
- my $error = $self->custnum
- ? $cust_main_invoice->check
- : $cust_main_invoice->checkdest
- ;
- return $error if $error;
-
- }
-
- return "Email address required"
- if $conf->exists('cust_main-require_invoicing_list_email')
- && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
-
- '';
-}
-
-=item set_default_invoicing_list
-
-Sets the invoicing list to all accounts associated with this customer,
-overwriting any previous invoicing list.
-
-=cut
-
-sub set_default_invoicing_list {
- my $self = shift;
- $self->invoicing_list($self->all_emails);
-}
-
-=item all_emails
-
-Returns the email addresses of all accounts provisioned for this customer.
-
-=cut
-
-sub all_emails {
- 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;
- $list{$_}=1 foreach map { $_->email } @svc_acct;
- }
- keys %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 invoicing_list_emailonly
-
-Returns the list of email invoice recipients (invoicing_list without non-email
-destinations such as POST and FAX).
-
-=cut
-
-sub invoicing_list_emailonly {
- my $self = shift;
- warn "$me invoicing_list_emailonly called"
- if $DEBUG;
- grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
-}
-
-=item invoicing_list_emailonly_scalar
-
-Returns the list of email invoice recipients (invoicing_list without non-email
-destinations such as POST and FAX) as a comma-separated scalar.
-
-=cut
-
-sub invoicing_list_emailonly_scalar {
- my $self = shift;
- warn "$me invoicing_list_emailonly_scalar called"
- if $DEBUG;
- join(', ', $self->invoicing_list_emailonly);
-}
-
-=item referral_custnum_cust_main
-
-Returns the customer who referred this customer (or the empty string, if
-this customer was not referred).
-
-Note the difference with referral_cust_main method: This method,
-referral_custnum_cust_main returns the single customer (if any) who referred
-this customer, while referral_cust_main returns an array of customers referred
-BY this customer.
-
-=cut
-
-sub referral_custnum_cust_main {
- my $self = shift;
- return '' unless $self->referral_custnum;
- qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
-}
-
-=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
-
-Returns an array of customers referred by this customer (referral_custnum set
-to this custnum). If DEPTH is given, recurses up to the given depth, returning
-customers referred by customers referred by this customer and so on, inclusive.
-The default behavior is DEPTH 1 (no recursion).
-
-Note the difference with referral_custnum_cust_main method: This method,
-referral_cust_main, returns an array of customers referred BY this customer,
-while referral_custnum_cust_main returns the single customer (if any) who
-referred this customer.
-
-=cut
-
-sub referral_cust_main {
- my $self = shift;
- my $depth = @_ ? shift : 1;
- my $exclude = @_ ? shift : {};
-
- my @cust_main =
- map { $exclude->{$_->custnum}++; $_; }
- grep { ! $exclude->{ $_->custnum } }
- qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
-
- if ( $depth > 1 ) {
- push @cust_main,
- map { $_->referral_cust_main($depth-1, $exclude) }
- @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 commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; 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 referring_cust_main
-
-Returns the single cust_main record for the customer who referred this customer
-(referral_custnum), or false.
-
-=cut
-
-sub referring_cust_main {
- my $self = shift;
- return '' unless $self->referral_custnum;
- qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
-}
-
-=item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
-
-Applies a credit to this customer. If there is an error, returns the error,
-otherwise returns false.
-
-REASON can be a text string, an FS::reason object, or a scalar reference to
-a reasonnum. If a text string, it will be automatically inserted as a new
-reason, and a 'reason_type' option must be passed to indicate the
-FS::reason_type for the new reason.
-
-An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
-
-Any other options are passed to FS::cust_credit::insert.
-
-=cut
-
-sub credit {
- my( $self, $amount, $reason, %options ) = @_;
-
- my $cust_credit = new FS::cust_credit {
- 'custnum' => $self->custnum,
- 'amount' => $amount,
- };
-
- if ( ref($reason) ) {
-
- if ( ref($reason) eq 'SCALAR' ) {
- $cust_credit->reasonnum( $$reason );
- } else {
- $cust_credit->reasonnum( $reason->reasonnum );
- }
-
- } else {
- $cust_credit->set('reason', $reason)
- }
-
- for (qw( addlinfo eventnum )) {
- $cust_credit->$_( delete $options{$_} )
- if exists($options{$_});
- }
-
- $cust_credit->insert(%options);
-
-}
-
-=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
-
-Creates a one-time charge for this customer. If there is an error, returns
-the error, otherwise returns false.
-
-New-style, with a hashref of options:
-
- my $error = $cust_main->charge(
- {
- 'amount' => 54.32,
- 'quantity' => 1,
- 'start_date' => str2time('7/4/2009'),
- 'pkg' => 'Description',
- 'comment' => 'Comment',
- 'additional' => [], #extra invoice detail
- 'classnum' => 1, #pkg_class
-
- 'setuptax' => '', # or 'Y' for tax exempt
-
- #internal taxation
- 'taxclass' => 'Tax class',
-
- #vendor taxation
- 'taxproduct' => 2, #part_pkg_taxproduct
- 'override' => {}, #XXX describe
-
- #will be filled in with the new object
- 'cust_pkg_ref' => \$cust_pkg,
-
- #generate an invoice immediately
- 'bill_now' => 0,
- 'invoice_terms' => '', #with these terms
- }
- );
-
-Old-style:
-
- my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
-
-=cut
-
-sub charge {
- my $self = shift;
- my ( $amount, $quantity, $start_date, $classnum );
- my ( $pkg, $comment, $additional );
- my ( $setuptax, $taxclass ); #internal taxes
- my ( $taxproduct, $override ); #vendor (CCH) taxes
- my $no_auto = '';
- my $cust_pkg_ref = '';
- my ( $bill_now, $invoice_terms ) = ( 0, '' );
- if ( ref( $_[0] ) ) {
- $amount = $_[0]->{amount};
- $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
- $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
- $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
- $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
- $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
- : '$'. sprintf("%.2f",$amount);
- $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
- $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
- $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
- $additional = $_[0]->{additional} || [];
- $taxproduct = $_[0]->{taxproductnum};
- $override = { '' => $_[0]->{tax_override} };
- $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
- $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
- $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
- } else {
- $amount = shift;
- $quantity = 1;
- $start_date = '';
- $pkg = @_ ? shift : 'One-time charge';
- $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
- $setuptax = '';
- $taxclass = @_ ? shift : '';
- $additional = [];
- }
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- my $part_pkg = new FS::part_pkg ( {
- 'pkg' => $pkg,
- 'comment' => $comment,
- 'plan' => 'flat',
- 'freq' => 0,
- 'disabled' => 'Y',
- 'classnum' => ( $classnum ? $classnum : '' ),
- 'setuptax' => $setuptax,
- 'taxclass' => $taxclass,
- 'taxproductnum' => $taxproduct,
- } );
-
- my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
- ( 0 .. @$additional - 1 )
- ),
- 'additional_count' => scalar(@$additional),
- 'setup_fee' => $amount,
- );
-
- my $error = $part_pkg->insert( options => \%options,
- tax_overrides => $override,
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- my $pkgpart = $part_pkg->pkgpart;
- my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
- unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
- my $type_pkgs = new FS::type_pkgs \%type_pkgs;
- $error = $type_pkgs->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $self->custnum,
- 'pkgpart' => $pkgpart,
- 'quantity' => $quantity,
- 'start_date' => $start_date,
- 'no_auto' => $no_auto,
- } );
-
- $error = $cust_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- } elsif ( $cust_pkg_ref ) {
- ${$cust_pkg_ref} = $cust_pkg;
- }
-
- if ( $bill_now ) {
- my $error = $self->bill( 'invoice_terms' => $invoice_terms,
- 'pkg_list' => [ $cust_pkg ],
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return '';
-
-}
-
-#=item charge_postal_fee
-#
-#Applies a one time charge this customer. If there is an error,
-#returns the error, returns the cust_pkg charge object or false
-#if there was no charge.
-#
-#=cut
-#
-# This should be a customer event. For that to work requires that bill
-# also be a customer event.
-
-sub charge_postal_fee {
- my $self = shift;
-
- my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
- return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
-
- my $cust_pkg = new FS::cust_pkg ( {
- 'custnum' => $self->custnum,
- 'pkgpart' => $pkgpart,
- 'quantity' => 1,
- } );
-
- my $error = $cust_pkg->insert;
- $error ? $error : $cust_pkg;
-}
-
-=item cust_bill
-
-Returns all the invoices (see L<FS::cust_bill>) for this customer.
-
-=cut
-
-sub cust_bill {
- my $self = shift;
- map { $_ } #return $self->num_cust_bill unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
-}
-
-=item open_cust_bill
-
-Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
-customer.
-
-=cut
-
-sub open_cust_bill {
- my $self = shift;
-
- qsearch({
- 'table' => 'cust_bill',
- 'hashref' => { 'custnum' => $self->custnum, },
- 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
- 'order_by' => 'ORDER BY _date ASC',
- });
-
-}
-
-=item cust_statements
-
-Returns all the statements (see L<FS::cust_statement>) for this customer.
-
-=cut
-
-sub cust_statement {
- my $self = shift;
- map { $_ } #return $self->num_cust_statement unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch('cust_statement', { 'custnum' => $self->custnum, } )
-}
-
-=item cust_credit
-
-Returns all the credits (see L<FS::cust_credit>) for this customer.
-
-=cut
-
-sub cust_credit {
- my $self = shift;
- map { $_ } #return $self->num_cust_credit unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
-}
-
-=item cust_credit_pkgnum
-
-Returns all the credits (see L<FS::cust_credit>) for this customer's specific
-package when using experimental package balances.
-
-=cut
-
-sub cust_credit_pkgnum {
- my( $self, $pkgnum ) = @_;
- map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_credit', { 'custnum' => $self->custnum,
- 'pkgnum' => $pkgnum,
- }
- );
-}
-
-=item cust_pay
-
-Returns all the payments (see L<FS::cust_pay>) for this customer.
-
-=cut
-
-sub cust_pay {
- my $self = shift;
- return $self->num_cust_pay unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
-}
-
-=item num_cust_pay
-
-Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
-called automatically when the cust_pay method is used in a scalar context.
-
-=cut
-
-sub num_cust_pay {
- my $self = shift;
- my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute($self->custnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item cust_pay_pkgnum
-
-Returns all the payments (see L<FS::cust_pay>) for this customer's specific
-package when using experimental package balances.
-
-=cut
-
-sub cust_pay_pkgnum {
- my( $self, $pkgnum ) = @_;
- map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay', { 'custnum' => $self->custnum,
- 'pkgnum' => $pkgnum,
- }
- );
-}
-
-=item cust_pay_void
-
-Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
-
-=cut
-
-sub cust_pay_void {
- my $self = shift;
- map { $_ } #return $self->num_cust_pay_void unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
-}
-
-=item cust_pay_batch
-
-Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
-
-=cut
-
-sub cust_pay_batch {
- my $self = shift;
- map { $_ } #return $self->num_cust_pay_batch unless wantarray;
- sort { $a->paybatchnum <=> $b->paybatchnum }
- qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
-}
-
-=item cust_pay_pending
-
-Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
-(without status "done").
-
-=cut
-
-sub cust_pay_pending {
- my $self = shift;
- return $self->num_cust_pay_pending unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_pending', {
- 'custnum' => $self->custnum,
- 'status' => { op=>'!=', value=>'done' },
- },
- );
-}
-
-=item cust_pay_pending_attempt
-
-Returns all payment attempts / declined payments for this customer, as pending
-payments objects (see L<FS::cust_pay_pending>), with status "done" but without
-a corresponding payment (see L<FS::cust_pay>).
-
-=cut
-
-sub cust_pay_pending_attempt {
- my $self = shift;
- return $self->num_cust_pay_pending_attempt unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_pay_pending', {
- 'custnum' => $self->custnum,
- 'status' => 'done',
- 'paynum' => '',
- },
- );
-}
-
-=item num_cust_pay_pending
-
-Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
-customer (without status "done"). Also called automatically when the
-cust_pay_pending method is used in a scalar context.
-
-=cut
-
-sub num_cust_pay_pending {
- my $self = shift;
- $self->scalar_sql(
- " SELECT COUNT(*) FROM cust_pay_pending ".
- " WHERE custnum = ? AND status != 'done' ",
- $self->custnum
- );
-}
-
-=item num_cust_pay_pending_attempt
-
-Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
-customer, with status "done" but without a corresp. Also called automatically when the
-cust_pay_pending method is used in a scalar context.
-
-=cut
-
-sub num_cust_pay_pending_attempt {
- my $self = shift;
- $self->scalar_sql(
- " SELECT COUNT(*) FROM cust_pay_pending ".
- " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
- $self->custnum
- );
-}
-
-=item cust_refund
-
-Returns all the refunds (see L<FS::cust_refund>) for this customer.
-
-=cut
-
-sub cust_refund {
- my $self = shift;
- map { $_ } #return $self->num_cust_refund unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
-}
-
-=item display_custnum
-
-Returns the displayed customer number for this customer: agent_custid if
-cust_main-default_agent_custid is set and it has a value, custnum otherwise.
-
-=cut
-
-sub display_custnum {
- my $self = shift;
- if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
- return $self->agent_custid;
- } else {
- return $self->custnum;
- }
-}
-
-=item name
-
-Returns a name string for this customer, either "Company (Last, First)" or
-"Last, First".
-
-=cut
-
-sub name {
- my $self = shift;
- my $name = $self->contact;
- $name = $self->company. " ($name)" if $self->company;
- $name;
-}
-
-=item ship_name
-
-Returns a name string for this (service/shipping) contact, either
-"Company (Last, First)" or "Last, First".
-
-=cut
-
-sub ship_name {
- my $self = shift;
- if ( $self->get('ship_last') ) {
- my $name = $self->ship_contact;
- $name = $self->ship_company. " ($name)" if $self->ship_company;
- $name;
- } else {
- $self->name;
- }
-}
-
-=item name_short
-
-Returns a name string for this customer, either "Company" or "First Last".
-
-=cut
-
-sub name_short {
- my $self = shift;
- $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
-}
-
-=item ship_name_short
-
-Returns a name string for this (service/shipping) contact, either "Company"
-or "First Last".
-
-=cut
-
-sub ship_name_short {
- my $self = shift;
- if ( $self->get('ship_last') ) {
- $self->ship_company !~ /^\s*$/
- ? $self->ship_company
- : $self->ship_contact_firstlast;
- } else {
- $self->name_company_or_firstlast;
- }
-}
-
-=item contact
-
-Returns this customer's full (billing) contact name only, "Last, First"
-
-=cut
-
-sub contact {
- my $self = shift;
- $self->get('last'). ', '. $self->first;
-}
-
-=item ship_contact
-
-Returns this customer's full (shipping) contact name only, "Last, First"
-
-=cut
-
-sub ship_contact {
- my $self = shift;
- $self->get('ship_last')
- ? $self->get('ship_last'). ', '. $self->ship_first
- : $self->contact;
-}
-
-=item contact_firstlast
-
-Returns this customers full (billing) contact name only, "First Last".
-
-=cut
-
-sub contact_firstlast {
- my $self = shift;
- $self->first. ' '. $self->get('last');
-}
-
-=item ship_contact_firstlast
-
-Returns this customer's full (shipping) contact name only, "First Last".
-
-=cut
-
-sub ship_contact_firstlast {
- my $self = shift;
- $self->get('ship_last')
- ? $self->first. ' '. $self->get('ship_last')
- : $self->contact_firstlast;
-}
-
-=item country_full
-
-Returns this customer's full country name
-
-=cut
-
-sub country_full {
- my $self = shift;
- code2country($self->country);
-}
-
-=item geocode DATA_VENDOR
-
-Returns a value for the customer location as encoded by DATA_VENDOR.
-Currently this only makes sense for "CCH" as DATA_VENDOR.
-
-=cut
-
-sub geocode {
- my ($self, $data_vendor) = (shift, shift); #always cch for now
-
- my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
- return $geocode if $geocode;
-
- my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
- ? 'ship_'
- : '';
-
- my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
- if $self->country eq 'US';
-
- $zip ||= '';
- $plus4 ||= '';
- #CCH specific location stuff
- my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
-
- my @cust_tax_location =
- qsearch( {
- 'table' => 'cust_tax_location',
- 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
- 'extra_sql' => $extra_sql,
- 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
- }
- );
- $geocode = $cust_tax_location[0]->geocode
- if scalar(@cust_tax_location);
-
- $geocode;
-}
-
-=item cust_status
-
-=item status
-
-Returns a status string for this customer, currently:
-
-=over 4
-
-=item prospect - No packages have ever been ordered
-
-=item ordered - Recurring packages all are new (not yet billed).
-
-=item active - One or more recurring packages is active
-
-=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
-
-=item suspended - All non-cancelled recurring packages are suspended
-
-=item cancelled - All recurring packages are cancelled
-
-=back
-
-=cut
-
-sub status { shift->cust_status(@_); }
-
-sub cust_status {
- my $self = shift;
- # prospect ordered active inactive suspended cancelled
- for my $status ( FS::cust_main->statuses() ) {
- my $method = $status.'_sql';
- my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
- my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
- $sth->execute( ($self->custnum) x $numnum )
- or die "Error executing 'SELECT $sql': ". $sth->errstr;
- return $status if $sth->fetchrow_arrayref->[0];
- }
-}
-
-=item ucfirst_cust_status
-
-=item ucfirst_status
-
-Returns the status with the first character capitalized.
-
-=cut
-
-sub ucfirst_status { shift->ucfirst_cust_status(@_); }
-
-sub ucfirst_cust_status {
- my $self = shift;
- ucfirst($self->cust_status);
-}
-
-=item statuscolor
-
-Returns a hex triplet color string for this customer's status.
-
-=cut
-
-use vars qw(%statuscolor);
-tie %statuscolor, 'Tie::IxHash',
- 'prospect' => '7e0079', #'000000', #black? naw, purple
- 'active' => '00CC00', #green
- 'ordered' => '009999', #teal? cyan?
- 'inactive' => '0000CC', #blue
- 'suspended' => 'FF9900', #yellow
- 'cancelled' => 'FF0000', #red
-;
-
-sub statuscolor { shift->cust_statuscolor(@_); }
-
-sub cust_statuscolor {
- my $self = shift;
- $statuscolor{$self->cust_status};
-}
-
-=item tickets
-
-Returns an array of hashes representing the customer's RT tickets.
-
-=cut
-
-sub tickets {
- my $self = shift;
-
- my $num = $conf->config('cust_main-max_tickets') || 10;
- my @tickets = ();
-
- if ( $conf->config('ticket_system') ) {
- unless ( $conf->config('ticket_system-custom_priority_field') ) {
-
- @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
-
- } else {
-
- foreach my $priority (
- $conf->config('ticket_system-custom_priority_field-values'), ''
- ) {
- last if scalar(@tickets) >= $num;
- push @tickets,
- @{ FS::TicketSystem->customer_tickets( $self->custnum,
- $num - scalar(@tickets),
- $priority,
- )
- };
- }
- }
- }
- (@tickets);
-}
-
-# Return services representing svc_accts in customer support packages
-sub support_services {
- my $self = shift;
- my %packages = map { $_ => 1 } $conf->config('support_packages');
-
- grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
- grep { $_->part_svc->svcdb eq 'svc_acct' }
- map { $_->cust_svc }
- grep { exists $packages{ $_->pkgpart } }
- $self->ncancelled_pkgs;
-
-}
-
-# Return a list of latitude/longitude for one of the services (if any)
-sub service_coordinates {
- my $self = shift;
-
- my @svc_X =
- grep { $_->latitude && $_->longitude }
- map { $_->svc_x }
- map { $_->cust_svc }
- $self->ncancelled_pkgs;
-
- scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
-}
-
-=back
-
-=head1 CLASS METHODS
-
-=over 4
-
-=item statuses
-
-Class method that returns the list of possible status strings for customers
-(see L<the status method|/status>). For example:
-
- @statuses = FS::cust_main->statuses();
-
-=cut
-
-sub statuses {
- #my $self = shift; #could be class...
- keys %statuscolor;
-}
-
-=item prospect_sql
-
-Returns an SQL expression identifying prospective cust_main records (customers
-with no packages ever ordered)
-
-=cut
-
-use vars qw($select_count_pkgs);
-$select_count_pkgs =
- "SELECT COUNT(*) FROM cust_pkg
- WHERE cust_pkg.custnum = cust_main.custnum";
-
-sub select_count_pkgs_sql {
- $select_count_pkgs;
-}
-
-sub prospect_sql {
- " 0 = ( $select_count_pkgs ) ";
-}
-
-=item ordered_sql
-
-Returns an SQL expression identifying ordered cust_main records (customers with
-recurring packages not yet setup).
-
-=cut
-
-sub ordered_sql {
- FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
-}
-
-=item active_sql
-
-Returns an SQL expression identifying active cust_main records (customers with
-active recurring packages).
-
-=cut
-
-sub active_sql {
- " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
-}
-
-=item none_active_sql
-
-Returns an SQL expression identifying cust_main records with no active
-recurring packages. This includes customers of status prospect, ordered,
-inactive, and suspended.
-
-=cut
-
-sub none_active_sql {
- " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
-}
-
-=item inactive_sql
-
-Returns an SQL expression identifying inactive cust_main records (customers with
-no active recurring packages, but otherwise unsuspended/uncancelled).
-
-=cut
-
-sub inactive_sql {
- FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
-}
-
-=item susp_sql
-=item suspended_sql
-
-Returns an SQL expression identifying suspended cust_main records.
-
-=cut
-
-
-sub suspended_sql { susp_sql(@_); }
-sub susp_sql {
- FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
-}
-
-=item cancel_sql
-=item cancelled_sql
-
-Returns an SQL expression identifying cancelled cust_main records.
-
-=cut
-
-sub cancelled_sql { cancel_sql(@_); }
-sub cancel_sql {
-
- my $recurring_sql = FS::cust_pkg->recurring_sql;
- my $cancelled_sql = FS::cust_pkg->cancelled_sql;
-
- "
- 0 < ( $select_count_pkgs )
- AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
- AND 0 = ( $select_count_pkgs AND $recurring_sql
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- )
- AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
- ";
-
-}
-
-=item uncancel_sql
-=item uncancelled_sql
-
-Returns an SQL expression identifying un-cancelled cust_main records.
-
-=cut
-
-sub uncancelled_sql { uncancel_sql(@_); }
-sub uncancel_sql { "
- ( 0 < ( $select_count_pkgs
- AND ( cust_pkg.cancel IS NULL
- OR cust_pkg.cancel = 0
- )
- )
- OR 0 = ( $select_count_pkgs )
- )
-"; }
-
-=item balance_sql
-
-Returns an SQL fragment to retreive the balance.
-
-=cut
-
-sub balance_sql { "
- ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
- WHERE cust_bill.custnum = cust_main.custnum )
- - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
- WHERE cust_pay.custnum = cust_main.custnum )
- - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
- WHERE cust_credit.custnum = cust_main.custnum )
- + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
- WHERE cust_refund.custnum = cust_main.custnum )
-"; }
-
-=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
-
-Returns an SQL fragment to retreive the balance for this customer, optionally
-considering invoices with date earlier than START_TIME, and not
-later than END_TIME (total_owed_date minus total_unapplied_credits minus
-total_unapplied_payments).
-
-Times are specified as SQL fragments or numeric
-UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. The empty string can be passed
-to disable that time constraint completely.
-
-Available options are:
-
-=over 4
-
-=item unapplied_date
-
-set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
-
-=item total
-
-(unused. obsolete?)
-set to true to remove all customer comparison clauses, for totals
-
-=item where
-
-(unused. obsolete?)
-WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
-
-=item join
-
-(unused. obsolete?)
-JOIN clause (typically used with the total option)
-
-=item cutoff
-
-An absolute cutoff time. Payments, credits, and refunds I<applied> after this
-time will be ignored. Note that START_TIME and END_TIME only limit the date
-range for invoices and I<unapplied> payments, credits, and refunds.
-
-=back
-
-=cut
-
-sub balance_date_sql {
- my( $class, $start, $end, %opt ) = @_;
-
- my $cutoff = $opt{'cutoff'};
-
- my $owed = FS::cust_bill->owed_sql($cutoff);
- my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
- my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
- my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
-
- my $j = $opt{'join'} || '';
-
- my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
- my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
- my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
- my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
-
- " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
- + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
- - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
- - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
- ";
-
-}
-
-=item unapplied_payments_date_sql START_TIME [ END_TIME ]
-
-Returns an SQL fragment to retreive the total unapplied payments for this
-customer, only considering invoices with date earlier than START_TIME, and
-optionally not later than END_TIME.
-
-Times are specified as SQL fragments or numeric
-UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
-L<Date::Parse> for conversion functions. The empty string can be passed
-to disable that time constraint completely.
-
-Available options are:
-
-=cut
-
-sub unapplied_payments_date_sql {
- my( $class, $start, $end, %opt ) = @_;
-
- my $cutoff = $opt{'cutoff'};
-
- my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
-
- my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
- 'unapplied_date'=>1 );
-
- " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
-}
-
-=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
-
-Helper method for balance_date_sql; name (and usage) subject to change
-(suggestions welcome).
-
-Returns a WHERE clause for the specified monetary TABLE (cust_bill,
-cust_refund, cust_credit or cust_pay).
-
-If TABLE is "cust_bill" or the unapplied_date option is true, only
-considers records with date earlier than START_TIME, and optionally not
-later than END_TIME .
-
-=cut
-
-sub _money_table_where {
- my( $class, $table, $start, $end, %opt ) = @_;
-
- my @where = ();
- push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
- if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
- push @where, "$table._date <= $start" if defined($start) && length($start);
- push @where, "$table._date > $end" if defined($end) && length($end);
- }
- push @where, @{$opt{'where'}} if $opt{'where'};
- my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
-
- $where;
-
-}
-
-=item search HASHREF
-
-(Class method)
-
-Returns a qsearch hash expression to search for parameters specified in
-HASHREF. Valid parameters are
-
-=over 4
-
-=item agentnum
-
-=item status
-
-=item cancelled_pkgs
projects / freeside.git / blobdiff