-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 ) : '';