- 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 ) : ()