+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 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 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 $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
+ ? 'ship_'
+ : '';
+
+ my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
+ if $self->country eq 'US';
+
+ #CCH specific location stuff
+ my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
+
+ my $geocode = '';
+ my $cust_tax_location =
+ qsearchs( {
+ 'table' => 'cust_tax_location',
+ 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
+ 'extra_sql' => $extra_sql,
+ }
+ );
+ $geocode = $cust_tax_location->geocode
+ if $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 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;
+ for my $status (qw( prospect active inactive suspended cancelled )) {
+ 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 my %statuscolor, 'Tie::IxHash',
+ 'prospect' => '7e0079', #'000000', #black? naw, purple
+ 'active' => '00CC00', #green
+ '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 = ();
+
+ 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;
+
+}
+
+=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 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 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 { "
+ 0 = ( $select_count_pkgs AND ". FS::cust_pkg->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 { "
+ 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
+ AND
+ 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_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 )
+ )
+ ";
+
+}
+
+=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, only
+considering invoices with date earlier than START_TIME, and optionally not
+later than END_TIME (total_owed_date minus total_credited 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 - set to true to remove all customer comparison clauses, for totals
+
+=item where - WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
+
+=item join - JOIN clause (typically used with the total option)
+
+=item
+
+=back
+
+=cut
+
+sub balance_date_sql {
+ my( $class, $start, $end, %opt ) = @_;
+
+ my $owed = FS::cust_bill->owed_sql;
+ my $unapp_refund = FS::cust_refund->unapplied_sql;
+ my $unapp_credit = FS::cust_credit->unapplied_sql;
+ my $unapp_pay = FS::cust_pay->unapplied_sql;
+
+ 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 _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_sql HASHREF
+
+(Class method)
+
+Returns a qsearch hash expression to search for parameters specified in HREF.
+Valid parameters are
+
+=over 4
+
+=item agentnum
+
+=item status
+
+=item cancelled_pkgs
+
+bool
+
+=item signupdate
+
+listref of start date, end date
+
+=item payby
+
+listref
+
+=item current_balance
+
+listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
+
+=item cust_fields
+
+=item flattened_pkgs
+
+bool
+
+=back
+
+=cut
+
+sub search_sql {
+ my ($class, $params) = @_;
+
+ my $dbh = dbh;
+
+ my @where = ();
+ my $orderby;
+
+ ##
+ # parse agent
+ ##
+
+ if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where,
+ "cust_main.agentnum = $1";
+ }
+
+ ##
+ # parse status
+ ##
+
+ #prospect active inactive suspended cancelled
+ if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
+ my $method = $params->{'status'}. '_sql';
+ #push @where, $class->$method();
+ push @where, FS::cust_main->$method();
+ }
+
+ ##
+ # parse cancelled package checkbox
+ ##
+
+ my $pkgwhere = "";
+
+ $pkgwhere .= "AND (cancel = 0 or cancel is null)"
+ unless $params->{'cancelled_pkgs'};
+
+ ##
+ # dates
+ ##
+
+ foreach my $field (qw( signupdate )) {
+
+ next unless exists($params->{$field});
+
+ my($beginning, $ending) = @{$params->{$field}};
+
+ push @where,
+ "cust_main.$field IS NOT NULL",
+ "cust_main.$field >= $beginning",
+ "cust_main.$field <= $ending";
+
+ $orderby ||= "ORDER BY cust_main.$field";
+
+ }
+
+ ###
+ # payby
+ ###
+
+ my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
+ if ( @payby ) {
+ push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
+ }
+
+ ##
+ # amounts
+ ##
+
+ #my $balance_sql = $class->balance_sql();
+ my $balance_sql = FS::cust_main->balance_sql();
+
+ push @where, map { s/current_balance/$balance_sql/; $_ }
+ @{ $params->{'current_balance'} };
+
+ ##
+ # setup queries, subs, etc. for the search
+ ##
+
+ $orderby ||= 'ORDER BY custnum';
+
+ # here is the agent virtualization
+ push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
+
+ my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
+
+ my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
+
+ my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
+
+ my $select = join(', ',
+ 'cust_main.custnum',
+ FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
+ );
+
+ my(@extra_headers) = ();
+ my(@extra_fields) = ();
+
+ if ($params->{'flattened_pkgs'}) {
+
+ if ($dbh->{Driver}->{Name} eq 'Pg') {
+
+ $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
+
+ }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
+ $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
+ $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
+ }else{
+ warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
+ "omitting packing information from report.";
+ }
+
+ my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
+
+ my $sth = dbh->prepare($header_query) or die dbh->errstr;
+ $sth->execute() or die $sth->errstr;
+ my $headerrow = $sth->fetchrow_arrayref;
+ my $headercount = $headerrow ? $headerrow->[0] : 0;
+ while($headercount) {
+ unshift @extra_headers, "Package ". $headercount;
+ unshift @extra_fields, eval q!sub {my $c = shift;
+ my @a = split '\|', $c->magic;
+ my $p = $a[!.--$headercount. q!];
+ $p;
+ };!;
+ }
+
+ }
+
+ my $sql_query = {
+ 'table' => 'cust_main',
+ 'select' => $select,
+ 'hashref' => {},
+ 'extra_sql' => $extra_sql,
+ 'order_by' => $orderby,
+ 'count_query' => $count_query,
+ 'extra_headers' => \@extra_headers,
+ 'extra_fields' => \@extra_fields,
+ };
+
+}
+
+=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
+
+Performs a fuzzy (approximate) search and returns the matching FS::cust_main
+records. Currently, I<first>, I<last> and/or I<company> may be specified (the
+appropriate ship_ field is also searched).
+
+Additional options are the same as FS::Record::qsearch
+
+=cut
+
+sub fuzzy_search {
+ my( $self, $fuzzy, $hash, @opt) = @_;
+ #$self
+ $hash ||= {};
+ my @cust_main = ();
+
+ check_and_rebuild_fuzzyfiles();
+ foreach my $field ( keys %$fuzzy ) {
+
+ my $all = $self->all_X($field);
+ next unless scalar(@$all);
+
+ my %match = ();
+ $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
+
+ my @fcust = ();
+ foreach ( keys %match ) {
+ push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
+ push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
+ }
+ my %fsaw = ();
+ push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
+ }
+
+ # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
+ my %saw = ();
+ @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
+
+ @cust_main;
+
+}
+
+=item masked FIELD
+
+Returns a masked version of the named field
+
+=cut
+
+sub masked {
+my ($self,$field) = @_;
+
+# Show last four
+
+'x'x(length($self->getfield($field))-4).
+ substr($self->getfield($field), (length($self->getfield($field))-4));
+
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item smart_search OPTION => VALUE ...
+
+Accepts the following options: I<search>, the string to search for. The string
+will be searched for as a customer number, phone number, name or company name,
+as an exact, or, in some cases, a substring or fuzzy match (see the source code
+for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
+skip fuzzy matching when an exact match is found.
+
+Any additional options are treated as an additional qualifier on the search
+(i.e. I<agentnum>).
+
+Returns a (possibly empty) array of FS::cust_main objects.
+
+=cut
+
+sub smart_search {
+ my %options = @_;
+
+ #here is the agent virtualization
+ my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
+
+ my @cust_main = ();
+
+ my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
+ my $search = delete $options{'search'};
+ ( my $alphanum_search = $search ) =~ s/\W//g;
+
+ if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
+
+ #false laziness w/Record::ut_phone
+ my $phonen = "$1-$2-$3";
+ $phonen .= " x$4" if $4;
+
+ push @cust_main, qsearch( {
+ 'table' => 'cust_main',
+ 'hashref' => { %options },
+ 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
+ ' ( '.
+ join(' OR ', map "$_ = '$phonen'",
+ qw( daytime night fax
+ ship_daytime ship_night ship_fax )
+ ).
+ ' ) '.
+ " AND $agentnums_sql", #agent virtualization
+ } );
+
+ unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
+ #try looking for matches with extensions unless one was specified
+
+ push @cust_main, qsearch( {
+ 'table' => 'cust_main',
+ 'hashref' => { %options },
+ 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
+ ' ( '.
+ join(' OR ', map "$_ LIKE '$phonen\%'",
+ qw( daytime night
+ ship_daytime ship_night )
+ ).
+ ' ) '.
+ " AND $agentnums_sql", #agent virtualization
+ } );
+
+ }
+
+ # custnum search (also try agent_custid), with some tweaking options if your
+ # legacy cust "numbers" have letters
+ } elsif ( $search =~ /^\s*(\d+)\s*$/
+ || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
+ && $search =~ /^\s*(\w\w?\d+)\s*$/
+ )
+ )
+ {
+
+ push @cust_main, qsearch( {
+ 'table' => 'cust_main',
+ 'hashref' => { 'custnum' => $1, %options },
+ 'extra_sql' => " AND $agentnums_sql", #agent virtualization
+ } );
+
+ push @cust_main, qsearch( {
+ 'table' => 'cust_main',
+ 'hashref' => { 'agent_custid' => $1, %options },
+ 'extra_sql' => " AND $agentnums_sql", #agent virtualization
+ } );
+
+ } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
+
+ my($company, $last, $first) = ( $1, $2, $3 );
+
+ # "Company (Last, First)"
+ #this is probably something a browser remembered,
+ #so just do an exact search
+
+ foreach my $prefix ( '', 'ship_' ) {
+ push @cust_main, qsearch( {
+ 'table' => 'cust_main',
+ 'hashref' => { $prefix.'first' => $first,
+ $prefix.'last' => $last,
+ $prefix.'company' => $company,
+ %options,
+ },
+ 'extra_sql' => " AND $agentnums_sql",
+ } );
+ }
+
+ } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
+ # try (ship_){last,company}
+
+ my $value = lc($1);
+
+ # # remove "(Last, First)" in "Company (Last, First)", otherwise the
+ # # full strings the browser remembers won't work
+ # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
+
+ use Lingua::EN::NameParse;
+ my $NameParse = new Lingua::EN::NameParse(
+ auto_clean => 1,
+ allow_reversed => 1,
+ );
+
+ my($last, $first) = ( '', '' );
+ #maybe disable this too and just rely on NameParse?
+ if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
+
+ ($last, $first) = ( $1, $2 );
+
+ #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
+ } elsif ( ! $NameParse->parse($value) ) {