FS/FS/cust_main/Search.pm

   1 package FS::cust_main::Search;
   2
   3 use strict;
   4 use base qw( Exporter );
   5 use vars qw( @EXPORT_OK $DEBUG $me $conf @fuzzyfields );
   6 use String::Approx qw(amatch);
   7 use FS::UID qw( dbh );
   8 use FS::Record qw( qsearch );
   9 use FS::cust_main;
  10 use FS::cust_main_invoice;
  11 use FS::svc_acct;
  12 use FS::payinfo_Mixin;
  13
  14 @EXPORT_OK = qw( smart_search );
  15
  16 # 1 is mostly method/subroutine entry and options
  17 # 2 traces progress of some operations
  18 # 3 is even more information including possibly sensitive data
  19 $DEBUG = 0;
  20 $me = '[FS::cust_main::Search]';
  21
  22 @fuzzyfields = (
  23   'cust_main.first', 'cust_main.last', 'cust_main.company',
  24   'cust_main.ship_company', # if you're using it
  25   'cust_location.address1',
  26   'contact.first',   'contact.last',
  27 );
  28
  29 install_callback FS::UID sub {
  30   $conf = new FS::Conf;
  31   #yes, need it for stuff below (prolly should be cached)
  32 };
  33
  34 =head1 NAME
  35
  36 FS::cust_main::Search - Customer searching
  37
  38 =head1 SYNOPSIS
  39
  40   use FS::cust_main::Search;
  41
  42   FS::cust_main::Search::smart_search(%options);
  43
  44   FS::cust_main::Search::email_search(%options);
  45
  46   FS::cust_main::Search->search( \%options );
  47
  48   FS::cust_main::Search->fuzzy_search( \%fuzzy_hashref );
  49
  50 =head1 SUBROUTINES
  51
  52 =over 4
  53
  54 =item smart_search OPTION => VALUE ...
  55
  56 Accepts the following options: I<search>, the string to search for.  The string
  57 will be searched for as a customer number, phone number, name or company name,
  58 address (if address1-search is on), invoicing email address, or credit card
  59 number.
  60
  61 Searches match as an exact, or, in some cases, a substring or fuzzy match (see
  62 the source code for the exact heuristics used); I<no_fuzzy_on_exact>, causes
  63 smart_search to
  64 skip fuzzy matching when an exact match is found.
  65
  66 Any additional options are treated as an additional qualifier on the search
  67 (i.e. I<agentnum>).
  68
  69 Returns a (possibly empty) array of FS::cust_main objects.
  70
  71 =cut
  72
  73 sub smart_search {
  74   my %options = @_;
  75
  76   #here is the agent virtualization
  77   my $agentnums_sql =
  78     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
  79   my $agentnums_href = $FS::CurrentUser::CurrentUser->agentnums_href;
  80
  81   my @cust_main = ();
  82
  83   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
  84   my $search = delete $options{'search'};
  85   ( my $alphanum_search = $search ) =~ s/\W//g;
  86
  87   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
  88
  89     #false laziness w/Record::ut_phone
  90     my $phonen = "$1-$2-$3";
  91     $phonen .= " x$4" if $4;
  92
  93     my $phonenum = "$1$2$3";
  94     #my $extension = $4;
  95
  96     #cust_main phone numbers and contact phone number
  97     push @cust_main, qsearch( {
  98       'select'    => 'cust_main.*',
  99       'table'     => 'cust_main',
 100       'addl_from' => ' left join contact  using (custnum) '.
 101                      ' left join contact_phone using (contactnum) ',
 102       'hashref'   => { %options },
 103       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
 104                      ' ( '.
 105                          join(' OR ', map "$_ = '$phonen'",
 106                                           qw( daytime night mobile fax )
 107                              ).
 108                           " OR phonenum = '$phonenum' ".
 109                      ' ) '.
 110                      " AND $agentnums_sql", #agent virtualization
 111     } );
 112
 113     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
 114       #try looking for matches with extensions unless one was specified
 115
 116       push @cust_main, qsearch( {
 117         'table'     => 'cust_main',
 118         'hashref'   => { %options },
 119         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
 120                        ' ( '.
 121                            join(' OR ', map "$_ LIKE '$phonen\%'",
 122                                             qw( daytime night )
 123                                ).
 124                        ' ) '.
 125                        " AND $agentnums_sql", #agent virtualization
 126       } );
 127
 128     }
 129
 130   }
 131
 132
 133   if ( $search =~ /@/ ) { #email address from cust_main_invoice and contact_email
 134
 135     push @cust_main, qsearch( {
 136       'select'    => 'cust_main.*',
 137       'table'     => 'cust_main',
 138       'addl_from' => ' left join cust_main_invoice using (custnum) '.
 139                      ' left join contact      using (custnum) '.
 140                      ' left join contact_email     using (contactnum) ',
 141       'hashref'   => { %options },
 142       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
 143                      ' ( '.
 144                          join(' OR ', map "$_ = '$search'",
 145                                           qw( dest emailaddress )
 146                              ).
 147                      ' ) '.
 148                      " AND $agentnums_sql", #agent virtualization
 149     } );
 150
 151   # custnum search (also try agent_custid), with some tweaking options if your
 152   # legacy cust "numbers" have letters
 153   } elsif (    $search =~ /^\s*(\d+)\s*$/
 154             or ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
 155                  && $search =~ /^\s*(\w\w?\d+)\s*$/
 156                )
 157             or ( $conf->config('cust_main-agent_custid-format') eq 'd+-w'
 158                  && $search =~ /^\s*(\d+-\w)\s*$/
 159                )
 160             or ( $conf->config('cust_main-custnum-display_special')
 161                  # it's not currently possible for special prefixes to contain
 162                  # digits, so just strip off any alphabetic prefix and match
 163                  # the rest to custnum
 164                  && $search =~ /^\s*[[:alpha:]]*(\d+)\s*$/
 165                )
 166             or ( $conf->exists('address1-search' )
 167                  && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
 168                )
 169           )
 170   {
 171
 172     my $num = $1;
 173
 174     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
 175       my $agent_custid_null = $conf->exists('cust_main-default_agent_custid')
 176                                 ? ' AND agent_custid IS NULL ' : '';
 177       push @cust_main, qsearch( {
 178         'table'     => 'cust_main',
 179         'hashref'   => { 'custnum' => $num, %options },
 180         'extra_sql' => " AND $agentnums_sql $agent_custid_null",
 181       } );
 182     }
 183
 184     # for all agents this user can see, if any of them have custnum prefixes
 185     # that match the search string, include customers that match the rest
 186     # of the custnum and belong to that agent
 187     foreach my $agentnum ( keys %$agentnums_href ) {
 188       my $p = $conf->config('cust_main-custnum-display_prefix', $agentnum);
 189       next if !$p;
 190       if ( $p eq substr($num, 0, length($p)) ) {
 191         push @cust_main, qsearch( {
 192           'table'   => 'cust_main',
 193           'hashref' => { 'custnum' => 0 + substr($num, length($p)),
 194                          'agentnum' => $agentnum,
 195                           %options,
 196                        },
 197         } );
 198       }
 199     }
 200
 201     push @cust_main, qsearch( {
 202         'table'     => 'cust_main',
 203         'hashref'   => { 'agent_custid' => $num, %options },
 204         'extra_sql' => " AND $agentnums_sql", #agent virtualization
 205     } );
 206
 207     if ( $conf->exists('address1-search') ) {
 208       my $len = length($num);
 209       $num = lc($num);
 210       # probably the Right Thing: return customers that have any associated
 211       # locations matching the string, not just bill/ship location
 212       push @cust_main, qsearch( {
 213         'select'    => 'cust_main.*',
 214         'table'     => 'cust_main',
 215         'addl_from' => ' JOIN cust_location USING (custnum) ',
 216         'hashref'   => { %options, },
 217         'extra_sql' =>
 218           ( keys(%options) ? ' AND ' : ' WHERE ' ).
 219           " LOWER(SUBSTRING(cust_location.address1 FROM 1 FOR $len)) = '$num' ".
 220           " AND $agentnums_sql",
 221       } );
 222     }
 223
 224   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
 225
 226     my($company, $last, $first) = ( $1, $2, $3 );
 227
 228     # "Company (Last, First)"
 229     #this is probably something a browser remembered,
 230     #so just do an exact search (but case-insensitive, so USPS standardization
 231     #doesn't throw a wrench in the works)
 232
 233     push @cust_main, qsearch( {
 234         'table'     => 'cust_main',
 235         'hashref'   => { %options },
 236         'extra_sql' =>
 237         ( keys(%options) ? ' AND ' : ' WHERE ' ).
 238         join(' AND ',
 239           " LOWER(first)   = ". dbh->quote(lc($first)),
 240           " LOWER(last)    = ". dbh->quote(lc($last)),
 241           " LOWER(company) = ". dbh->quote(lc($company)),
 242           $agentnums_sql,
 243         ),
 244       } ),
 245
 246     #contacts?
 247     # probably not necessary for the "something a browser remembered" case
 248
 249   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
 250                                               # try {first,last,company}
 251
 252     my $value = lc($1);
 253
 254     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
 255     # # full strings the browser remembers won't work
 256     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
 257
 258     use Lingua::EN::NameParse;
 259     my $NameParse = new Lingua::EN::NameParse(
 260              auto_clean     => 1,
 261              allow_reversed => 1,
 262     );
 263
 264     my($last, $first) = ( '', '' );
 265     #maybe disable this too and just rely on NameParse?
 266     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
 267
 268       ($last, $first) = ( $1, $2 );
 269
 270     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
 271     } elsif ( ! $NameParse->parse($value) ) {
 272
 273       my %name = $NameParse->components;
 274       $first = lc($name{'given_name_1'}) || $name{'initials_1'}; #wtf NameParse, Ed?
 275       $last  = lc($name{'surname_1'});
 276
 277     }
 278
 279     if ( $first && $last ) {
 280
 281       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
 282
 283       #exact
 284       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
 285       $sql .= "( (LOWER(cust_main.last) = $q_last AND LOWER(cust_main.first) = $q_first)
 286                  OR (LOWER(contact.last) = $q_last AND LOWER(contact.first) = $q_first) )";
 287
 288       #cust_main and contacts
 289       push @cust_main, qsearch( {
 290         'select'    => 'cust_main.*',
 291         'table'     => 'cust_main',
 292         'addl_from' => ' left join contact using (custnum) ',
 293         'hashref'   => { %options },
 294         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
 295       } );
 296
 297       # or it just be something that was typed in... (try that in a sec)
 298
 299     }
 300
 301     my $q_value = dbh->quote($value);
 302
 303     #exact
 304     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
 305     $sql .= " (    LOWER(cust_main.first)         = $q_value
 306                 OR LOWER(cust_main.last)          = $q_value
 307                 OR LOWER(cust_main.company)       = $q_value
 308                 OR LOWER(cust_main.ship_company)  = $q_value
 309                 OR LOWER(contact.first)           = $q_value
 310                 OR LOWER(contact.last)            = $q_value
 311             )";
 312
 313     #address1 (yes, it's a kludge)
 314     $sql .= "   OR EXISTS (
 315                             SELECT 1 FROM cust_location
 316                               WHERE LOWER(cust_location.address1) = $q_value
 317                                 AND cust_location.custnum = cust_main.custnum
 318                           )"
 319       if $conf->exists('address1-search');
 320
 321     push @cust_main, qsearch( {
 322       'select'    => 'cust_main.*',
 323       'table'     => 'cust_main',
 324       'addl_from' => ' left join contact using (custnum) ',
 325       'hashref'   => { %options },
 326       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
 327     } );
 328
 329     #no exact match, trying substring/fuzzy
 330     #always do substring & fuzzy (unless they're explicity config'ed off)
 331     #getting complaints searches are not returning enough
 332     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
 333
 334       #still some false laziness w/search (was search/cust_main.cgi)
 335
 336       my $min_len =
 337         $FS::CurrentUser::CurrentUser->access_right('List all customers')
 338         ? 3 : 4;
 339
 340       #substring
 341
 342       my @company_hashrefs = ();
 343       if ( length($value) >= $min_len ) {
 344         @company_hashrefs = (
 345           { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
 346           { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
 347         );
 348       }
 349
 350       my @hashrefs = ();
 351       if ( $first && $last ) {
 352
 353         @hashrefs = (
 354           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
 355             'last'         => { op=>'ILIKE', value=>"%$last%" },
 356           },
 357         );
 358
 359       } elsif ( length($value) >= $min_len ) {
 360
 361         @hashrefs = (
 362           { 'first'        => { op=>'ILIKE', value=>"%$value%" }, },
 363           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
 364         );
 365
 366       }
 367
 368       foreach my $hashref ( @company_hashrefs, @hashrefs ) {
 369
 370         push @cust_main, qsearch( {
 371           'table'     => 'cust_main',
 372           'hashref'   => { %$hashref,
 373                            %options,
 374                          },
 375           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
 376         } );
 377
 378       }
 379
 380       if ( $conf->exists('address1-search') && length($value) >= $min_len ) {
 381
 382         push @cust_main, qsearch( {
 383           select    => 'cust_main.*',
 384           table     => 'cust_main',
 385           addl_from => 'JOIN cust_location USING (custnum)',
 386           extra_sql => 'WHERE '.
 387                         ' cust_location.address1 ILIKE '.dbh->quote("%$value%").
 388                         " AND $agentnums_sql", #agent virtualizaiton
 389         } );
 390
 391       }
 392
 393       #contact substring
 394
 395       foreach my $hashref ( @hashrefs ) {
 396
 397         push @cust_main,
 398           grep $agentnums_href->{$_->agentnum}, #agent virt
 399             grep $_, #skip contacts that don't have cust_main records
 400               map $_->cust_main,
 401                 qsearch({
 402                           'table'     => 'contact',
 403                           'hashref'   => { %$hashref,
 404                                            #%options,
 405                                          },
 406                           #'extra_sql' => " AND $agentnums_sql", #agent virt
 407                        });
 408
 409       }
 410
 411       #fuzzy
 412       my %fuzopts = (
 413         'hashref'   => \%options,
 414         'select'    => '',
 415         'extra_sql' => "WHERE $agentnums_sql",    #agent virtualization
 416       );
 417
 418       if ( $first && $last ) {
 419         push @cust_main, FS::cust_main::Search->fuzzy_search(
 420           { 'last'   => $last,    #fuzzy hashref
 421             'first'  => $first }, #
 422           %fuzopts
 423         );
 424         push @cust_main, FS::cust_main::Search->fuzzy_search(
 425           { 'contact.last'   => $last,    #fuzzy hashref
 426             'contact.first'  => $first }, #
 427           %fuzopts
 428         );
 429       }
 430
 431       foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
 432         push @cust_main, FS::cust_main::Search->fuzzy_search(
 433           { $field => $value },
 434           %fuzopts
 435         );
 436       }
 437       foreach my $field ( 'first', 'last' ) {
 438         push @cust_main, FS::cust_main::Search->fuzzy_search(
 439           { "contact.$field" => $value },
 440           %fuzopts
 441         );
 442       }
 443       if ( $conf->exists('address1-search') ) {
 444         push @cust_main,
 445           FS::cust_main::Search->fuzzy_search(
 446             { 'cust_location.address1' => $value },
 447             %fuzopts
 448         );
 449       }
 450
 451     }
 452
 453   }
 454
 455   ( my $nospace_search = $search ) =~ s/\s//g;
 456   ( my $card_search = $nospace_search ) =~ s/\-//g;
 457   $card_search =~ s/[x\*\.\_]/x/gi;
 458
 459   if ( $card_search =~ /^[\dx]{15,16}$/i ) { #credit card search
 460
 461     ( my $like_search = $card_search ) =~ s/x/_/g;
 462     my $mask_search = FS::payinfo_Mixin->mask_payinfo('CARD', $card_search);
 463
 464     push @cust_main, qsearch({
 465       'table'     => 'cust_main',
 466       'hashref'   => {},
 467       'extra_sql' => " WHERE (    payinfo LIKE '$like_search'
 468                                OR paymask =    '$mask_search'
 469                              ) ".
 470                      " AND payby IN ('CARD','DCRD') ".
 471                      " AND $agentnums_sql", #agent virtulization
 472     });
 473
 474   }
 475
 476
 477   #eliminate duplicates
 478   my %saw = ();
 479   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
 480
 481   @cust_main;
 482
 483 }
 484
 485 =item email_search
 486
 487 Accepts the following options: I<email>, the email address to search for.  The
 488 email address will be searched for as an email invoice destination and as an
 489 svc_acct account.
 490
 491 #Any additional options are treated as an additional qualifier on the search
 492 #(i.e. I<agentnum>).
 493
 494 Returns a (possibly empty) array of FS::cust_main objects (but usually just
 495 none or one).
 496
 497 =cut
 498
 499 sub email_search {
 500   my %options = @_;
 501
 502   my $email = delete $options{'email'};
 503
 504   #no agent virtualization yet
 505   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
 506
 507   my @cust_main = ();
 508
 509   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
 510
 511     my ( $user, $domain ) = ( $1, $2 );
 512
 513     warn "$me smart_search: searching for $user in domain $domain"
 514       if $DEBUG;
 515
 516     push @cust_main,
 517       map $_->cust_main,
 518           qsearch( {
 519                      'table'     => 'cust_main_invoice',
 520                      'hashref'   => { 'dest' => $email },
 521                    }
 522                  );
 523
 524     push @cust_main,
 525       map  $_->cust_main,
 526       grep $_,
 527       map  $_->cust_svc->cust_pkg,
 528           qsearch( {
 529                      'table'     => 'svc_acct',
 530                      'hashref'   => { 'username' => $user, },
 531                      'extra_sql' =>
 532                        'AND ( SELECT domain FROM svc_domain
 533                                 WHERE svc_acct.domsvc = svc_domain.svcnum
 534                             ) = '. dbh->quote($domain),
 535                    }
 536                  );
 537   }
 538
 539   my %saw = ();
 540   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
 541
 542   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
 543     if $DEBUG;
 544
 545   @cust_main;
 546
 547 }
 548
 549 =back
 550
 551 =head1 CLASS METHODS
 552
 553 =over 4
 554
 555 =item search HASHREF
 556
 557 (Class method)
 558
 559 Returns a qsearch hash expression to search for parameters specified in
 560 HASHREF.  Valid parameters are
 561
 562 =over 4
 563
 564 =item agentnum
 565
 566 =item status
 567
 568 =item address
 569
 570 =item zip
 571
 572 =item refnum
 573
 574 =item cancelled_pkgs
 575
 576 bool
 577
 578 =item signupdate
 579
 580 listref of start date, end date
 581
 582 =item birthdate
 583
 584 listref of start date, end date
 585
 586 =item spouse_birthdate
 587
 588 listref of start date, end date
 589
 590 =item anniversary_date
 591
 592 listref of start date, end date
 593
 594 =item payby
 595
 596 listref
 597
 598 =item paydate_year
 599
 600 =item paydate_month
 601
 602 =item current_balance
 603
 604 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
 605
 606 =item cust_fields
 607
 608 =item flattened_pkgs
 609
 610 bool
 611
 612 =back
 613
 614 =cut
 615
 616 sub search {
 617   my ($class, $params) = @_;
 618
 619   my $dbh = dbh;
 620
 621   my @where = ();
 622   my $orderby;
 623
 624   # initialize these to prevent warnings
 625   $params = {
 626     'custnum'       => '',
 627     'agentnum'      => '',
 628     'usernum'       => '',
 629     'status'        => '',
 630     'address'       => '',
 631     'zip'           => '',
 632     'paydate_year'  => '',
 633     'invoice_terms' => '',
 634     'custbatch'     => '',
 635     %$params
 636   };
 637
 638   ##
 639   # explicit custnum(s)
 640   ##
 641
 642   if ( $params->{'custnum'} ) {
 643     my @custnums = ref($params->{'custnum'}) ?
 644                       @{ $params->{'custnum'} } :
 645                       $params->{'custnum'};
 646     push @where,
 647       'cust_main.custnum IN (' .
 648       join(',', map { $_ =~ /^(\d+)$/ ? $1 : () } @custnums ) .
 649       ')' if scalar(@custnums) > 0;
 650   }
 651
 652   ##
 653   # parse agent
 654   ##
 655
 656   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
 657     push @where,
 658       "cust_main.agentnum = $1";
 659   }
 660
 661   ##
 662   # parse sales person
 663   ##
 664
 665   if ( $params->{'salesnum'} =~ /^(\d+)$/ ) {
 666     push @where, ($1 > 0 ) ? "cust_main.salesnum = $1"
 667                            : 'cust_main.salesnum IS NULL';
 668   }
 669
 670   ##
 671   # parse usernum
 672   ##
 673
 674   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
 675     push @where,
 676       "cust_main.usernum = $1";
 677   }
 678
 679   ##
 680   # parse status
 681   ##
 682
 683   #prospect ordered active inactive suspended cancelled
 684   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
 685     my $method = $params->{'status'}. '_sql';
 686     #push @where, $class->$method();
 687     push @where, FS::cust_main->$method();
 688   }
 689
 690   my $current = '';
 691   unless ( $params->{location_history} ) {
 692     $current = '
 693       AND (    cust_location.locationnum IN ( cust_main.bill_locationnum,
 694                                               cust_main.ship_locationnum
 695                                             )
 696             OR cust_location.locationnum IN (
 697                  SELECT locationnum FROM cust_pkg
 698                   WHERE cust_pkg.custnum = cust_main.custnum
 699                     AND locationnum IS NOT NULL
 700                     AND '. FS::cust_pkg->ncancelled_recurring_sql.'
 701                )
 702           )';
 703   }
 704
 705   ##
 706   # address
 707   ##
 708   if ( $params->{'address'} ) {
 709     # allow this to be an arrayref
 710     my @values = ($params->{'address'});
 711     @values = @{$values[0]} if ref($values[0]);
 712     my @orwhere;
 713     foreach (grep /\S/, @values) {
 714       my $address = dbh->quote('%'. lc($_). '%');
 715       push @orwhere,
 716         "LOWER(cust_location.address1) LIKE $address",
 717         "LOWER(cust_location.address2) LIKE $address";
 718     }
 719     if (@orwhere) {
 720       push @where, "EXISTS(
 721         SELECT 1 FROM cust_location
 722         WHERE cust_location.custnum = cust_main.custnum
 723           AND (".join(' OR ',@orwhere).")
 724           $current
 725         )";
 726     }
 727   }
 728
 729   ##
 730   # city
 731   ##
 732   if ( $params->{'city'} =~ /\S/ ) {
 733     my $city = dbh->quote($params->{'city'});
 734     push @where, "EXISTS(
 735       SELECT 1 FROM cust_location
 736       WHERE cust_location.custnum = cust_main.custnum
 737         AND cust_location.city = $city
 738         $current
 739     )";
 740   }
 741
 742   ##
 743   # county
 744   ##
 745   if ( $params->{'county'} =~ /\S/ ) {
 746     my $county = dbh->quote($params->{'county'});
 747     push @where, "EXISTS(
 748       SELECT 1 FROM cust_location
 749       WHERE cust_location.custnum = cust_main.custnum
 750         AND cust_location.county = $county
 751         $current
 752     )";
 753   }
 754
 755   ##
 756   # state
 757   ##
 758   if ( $params->{'state'} =~ /\S/ ) {
 759     my $state = dbh->quote($params->{'state'});
 760     push @where, "EXISTS(
 761       SELECT 1 FROM cust_location
 762       WHERE cust_location.custnum = cust_main.custnum
 763         AND cust_location.state = $state
 764         $current
 765     )";
 766   }
 767
 768   ##
 769   # zipcode
 770   ##
 771   if ( $params->{'zip'} =~ /\S/ ) {
 772     my $zip = dbh->quote($params->{'zip'} . '%');
 773     push @where, "EXISTS(
 774       SELECT 1 FROM cust_location
 775       WHERE cust_location.custnum = cust_main.custnum
 776         AND cust_location.zip LIKE $zip
 777         $current
 778     )";
 779   }
 780
 781   ##
 782   # country
 783   ##
 784   if ( $params->{'country'} =~ /^(\w\w)$/ ) {
 785     my $country = uc($1);
 786     push @where, "EXISTS(
 787       SELECT 1 FROM cust_location
 788       WHERE cust_location.custnum = cust_main.custnum
 789         AND cust_location.country = '$country'
 790         $current
 791     )";
 792   }
 793
 794   ##
 795   # no_censustract
 796   ##
 797   if ( $params->{'no_censustract'} ) {
 798     push @where, "EXISTS(
 799       SELECT 1 FROM cust_location
 800       WHERE locationnum = cust_main.ship_locationnum
 801         AND cust_location.country = 'US'
 802         AND (    cust_location.censusyear IS NULL
 803               OR cust_location.censusyear != '2020'
 804             )
 805     )";
 806   }
 807
 808   ##
 809   # phones
 810   ##
 811
 812   foreach my $phonet (qw(daytime night mobile fax)) {
 813     if ($params->{$phonet}) {
 814       $params->{$phonet} =~ s/\D//g;
 815       $params->{$phonet} =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
 816         or next;
 817       my $phonen = "$1-$2-$3";
 818       if ($4) { push @where, "cust_main.".$phonet." = '".$phonen." x$4'"; }
 819       else { push @where, "cust_main.".$phonet." like '".$phonen."%'"; }
 820     }
 821   }
 822
 823   ###
 824   # refnum
 825   ###
 826   if ( $params->{'refnum'}  ) {
 827
 828     my @refnum = ref( $params->{'refnum'} )
 829                    ? @{ $params->{'refnum'} }
 830                    :  ( $params->{'refnum'} );
 831
 832     @refnum = grep /^(\d*)$/, @refnum;
 833
 834     push @where, '( '. join(' OR ', map "cust_main.refnum = $_", @refnum ). ' )'
 835       if @refnum;
 836
 837   }
 838
 839   ##
 840   # parse cancelled package checkbox
 841   ##
 842
 843   my $pkgwhere = "";
 844
 845   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
 846     unless $params->{'cancelled_pkgs'};
 847
 848   ##
 849   # "with email address(es)" checkbox
 850   ##
 851
 852   push @where,
 853     'EXISTS ( SELECT 1 FROM cust_main_invoice
 854                 WHERE cust_main_invoice.custnum = cust_main.custnum
 855                   AND length(dest) > 5
 856             )'  # AND dest LIKE '%@%'
 857     if $params->{'with_email'};
 858
 859   ##
 860   # "with postal mail invoices" checkbox
 861   ##
 862
 863   push @where,
 864     "EXISTS ( SELECT 1 FROM cust_main_invoice
 865                 WHERE cust_main_invoice.custnum = cust_main.custnum
 866                   AND dest = 'POST' )"
 867     if $params->{'POST'};
 868
 869   ##
 870   # "without postal mail invoices" checkbox
 871   ##
 872
 873   push @where,
 874     "NOT EXISTS ( SELECT 1 FROM cust_main_invoice
 875                     WHERE cust_main_invoice.custnum = cust_main.custnum
 876                       AND dest = 'POST' )"
 877     if $params->{'no_POST'};
 878
 879   ##
 880   # "tax exempt" checkbox
 881   ##
 882   push @where, "cust_main.tax = 'Y'"
 883     if $params->{'tax'};
 884
 885   ##
 886   # "not tax exempt" checkbox
 887   ##
 888   push @where, "(cust_main.tax = '' OR cust_main.tax IS NULL )"
 889     if $params->{'no_tax'};
 890
 891   ##
 892   # with referrals
 893   ##
 894   if ( $params->{with_referrals} =~ /^\s*(\d+)\s*$/ ) {
 895
 896     my $n = $1;
 897
 898     # referral status
 899     my $and_status = '';
 900     if ( grep { $params->{referral_status} eq $_ } FS::cust_main->statuses() ) {
 901       my $method = $params->{referral_status}. '_sql';
 902       $and_status = ' AND '. FS::cust_main->$method();
 903       $and_status =~ s/ cust_main\./ referred_cust_main./g;
 904     }
 905
 906     push @where,
 907       " $n <= ( SELECT COUNT(*) FROM cust_main AS referred_cust_main
 908                   WHERE cust_main.custnum = referred_cust_main.referral_custnum
 909                     $and_status
 910               )";
 911
 912   }
 913
 914   ##
 915   # dates
 916   ##
 917
 918   foreach my $field (qw( signupdate birthdate spouse_birthdate anniversary_date )) {
 919
 920     next unless exists($params->{$field});
 921
 922     my($beginning, $ending, $hour) = @{$params->{$field}};
 923
 924     push @where,
 925       "cust_main.$field IS NOT NULL",
 926       "cust_main.$field >= $beginning",
 927       "cust_main.$field <= $ending";
 928
 929     if($field eq 'signupdate' && defined $hour) {
 930       if ($dbh->{Driver}->{Name} =~ /Pg/i) {
 931         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
 932       }
 933       elsif( $dbh->{Driver}->{Name} =~ /mysql/i) {
 934         push @where, "hour(from_unixtime(cust_main.$field)) = $hour"
 935       }
 936       else {
 937         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
 938       }
 939     }
 940
 941     $orderby ||= "ORDER BY cust_main.$field";
 942
 943   }
 944
 945   ###
 946   # classnum
 947   ###
 948
 949   if ( $params->{'classnum'} ) {
 950
 951     my @classnum = ref( $params->{'classnum'} )
 952                      ? @{ $params->{'classnum'} }
 953                      :  ( $params->{'classnum'} );
 954
 955     @classnum = grep /^(\d*)$/, @classnum;
 956
 957     if ( @classnum ) {
 958       push @where, '( '. join(' OR ', map {
 959                                             $_ ? "cust_main.classnum = $_"
 960                                                : "cust_main.classnum IS NULL"
 961                                           }
 962                                           @classnum
 963                              ).
 964                    ' )';
 965     }
 966
 967   }
 968
 969   ###
 970   # payby
 971   ###
 972
 973   if ( $params->{'payby'} ) {
 974
 975     my @payby = ref( $params->{'payby'} )
 976                   ? @{ $params->{'payby'} }
 977                   :  ( $params->{'payby'} );
 978
 979     @payby = grep /^([A-Z]{4})$/, @payby;
 980
 981     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
 982       if @payby;
 983
 984   }
 985
 986   ###
 987   # paydate_year / paydate_month
 988   ###
 989
 990   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
 991     my $year = $1;
 992     $params->{'paydate_month'} =~ /^(\d\d?)$/
 993       or die "paydate_year without paydate_month?";
 994     my $month = $1;
 995
 996     push @where,
 997       'paydate IS NOT NULL',
 998       "paydate != ''",
 999       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
1000 ;
1001   }
1002
1003   ###
1004   # invoice terms
1005   ###
1006
1007   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
1008     my $terms = $1;
1009     if ( $1 eq 'NULL' ) {
1010       push @where,
1011         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
1012     } else {
1013       push @where,
1014         "cust_main.invoice_terms IS NOT NULL",
1015         "cust_main.invoice_terms = '$1'";
1016     }
1017   }
1018
1019   ##
1020   # amounts
1021   ##
1022
1023   if ( $params->{'current_balance'} ) {
1024
1025     #my $balance_sql = $class->balance_sql();
1026     my $balance_sql = FS::cust_main->balance_sql();
1027
1028     my @current_balance =
1029       ref( $params->{'current_balance'} )
1030       ? @{ $params->{'current_balance'} }
1031       :  ( $params->{'current_balance'} );
1032
1033     push @where, map { s/current_balance/$balance_sql/; $_ }
1034                      @current_balance;
1035
1036   }
1037
1038   ##
1039   # custbatch
1040   ##
1041
1042   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
1043     push @where,
1044       "cust_main.custbatch = '$1'";
1045   }
1046
1047   if ( $params->{'tagnum'} ) {
1048     my @tagnums = ref( $params->{'tagnum'} ) ? @{ $params->{'tagnum'} } : ( $params->{'tagnum'} );
1049
1050     @tagnums = grep /^(\d+)$/, @tagnums;
1051
1052     if ( @tagnums ) {
1053       if ( $params->{'all_tags'} ) {
1054         my $exists = $params->{'all_tags'} eq 'all' ? 'exists' : 'not exists';
1055         foreach ( @tagnums ) {
1056           push @where, $exists.'(select 1 from cust_tag where '.
1057                        'cust_tag.custnum = cust_main.custnum and tagnum = '.
1058                        $_ . ')';
1059         }
1060       } else { # matching any tag, not all
1061         my $tags_where = "0 < (select count(1) from cust_tag where "
1062                 . " cust_tag.custnum = cust_main.custnum and tagnum in ("
1063                 . join(',', @tagnums) . "))";
1064
1065         push @where, $tags_where;
1066       }
1067     }
1068   }
1069
1070   # pkg_classnum
1071   #   all_pkg_classnums
1072   #   any_pkg_status
1073   if ( $params->{'pkg_classnum'} ) {
1074     my @pkg_classnums = ref( $params->{'pkg_classnum'} ) ?
1075                           @{ $params->{'pkg_classnum'} } :
1076                              $params->{'pkg_classnum'};
1077     @pkg_classnums = grep /^(\d+)$/, @pkg_classnums;
1078
1079     if ( @pkg_classnums ) {
1080
1081       my @pkg_where;
1082       if ( $params->{'all_pkg_classnums'} ) {
1083         push @pkg_where, "part_pkg.classnum = $_" foreach @pkg_classnums;
1084       } else {
1085         push @pkg_where,
1086           'part_pkg.classnum IN('. join(',', @pkg_classnums).')';
1087       }
1088       foreach (@pkg_where) {
1089         my $select_pkg =
1090           "SELECT 1 FROM cust_pkg JOIN part_pkg USING (pkgpart) WHERE ".
1091           "cust_pkg.custnum = cust_main.custnum AND $_ ";
1092         if ( not $params->{'any_pkg_status'} ) {
1093           $select_pkg .= 'AND '.FS::cust_pkg->active_sql;
1094         }
1095         push @where, "EXISTS($select_pkg)";
1096       }
1097     }
1098   }
1099
1100   ##
1101   # contacts
1102   ##
1103   if (keys %{ $params->{'contacts'} }) {
1104     my $contact_params = $params->{'contacts'};
1105
1106     if ($contact_params->{'contacts_firstname'} || $contact_params->{'contacts_lastname'}) {
1107       my $first_query = " AND contact.first = '" . $contact_params->{'contacts_firstname'} . "'"
1108         unless !$contact_params->{'contacts_firstname'};
1109       my $last_query = " AND contact.last = '" . $contact_params->{'contacts_lastname'} . "'"
1110         unless !$contact_params->{'contacts_lastname'};
1111       push @where,
1112       "EXISTS ( SELECT 1 FROM contact
1113                 WHERE contact.custnum = cust_main.custnum
1114                 $first_query $last_query
1115               ) ";
1116     }
1117
1118     if ($contact_params->{'contacts_email'}) {
1119       push @where,
1120       "EXISTS ( SELECT 1 FROM contact_email
1121                 JOIN contact USING (contactnum)
1122                 WHERE contact.custnum = cust_main.custnum
1123                 AND contact_email.emailaddress = '" . $contact_params->{'contacts_email'} . "'
1124               ) ";
1125     }
1126
1127     if ( grep { /^contacts_phonetypenum(\d+)$/ } keys %{ $contact_params } ) {
1128       my $phone_query;
1129       foreach my $phone ( grep { /^contacts_phonetypenum(\d+)$/ } keys %{ $contact_params } ) {
1130         $phone =~ /^contacts_phonetypenum(\d+)$/ or die "No phone type num $1 from $phone";
1131         my $phonetypenum = $1;
1132         (my $num = $contact_params->{$phone}) =~ s/\W//g;
1133         if ( $num =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { $contact_params->{$phone} = "$1$2$3"; }
1134         $phone_query .= " AND ( contact_phone.phonetypenum = '".$phonetypenum."' AND contact_phone.phonenum = '" . $contact_params->{$phone} . "' )"
1135         unless !$contact_params->{$phone};
1136       }
1137       push @where,
1138       "EXISTS ( SELECT 1 FROM contact_phone
1139                 JOIN contact USING (contactnum)
1140                 WHERE contact.custnum = cust_main.custnum
1141                 $phone_query
1142               ) ";
1143     }
1144   }
1145
1146
1147   ##
1148   # setup queries, subs, etc. for the search
1149   ##
1150
1151   $orderby ||= 'ORDER BY cust_main.custnum';
1152
1153   # here is the agent virtualization
1154   push @where,
1155     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
1156
1157   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
1158
1159   my $addl_from = '';
1160   # always make address fields available in results
1161   for my $pre ('bill_', 'ship_') {
1162     $addl_from .=
1163       'LEFT JOIN cust_location AS '.$pre.'location '.
1164       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
1165   }
1166
1167   # always make referral available in results
1168   #   (maybe we should be using FS::UI::Web::join_cust_main instead?)
1169   $addl_from .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
1170
1171   my @select = (
1172                  'cust_main.custnum',
1173                  'cust_main.salesnum',
1174                  # there's a good chance that we'll need these
1175                  'cust_main.bill_locationnum',
1176                  'cust_main.ship_locationnum',
1177                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
1178                );
1179
1180   my @extra_headers     = ();
1181   my @extra_fields      = ();
1182   my @extra_sort_fields = ();
1183
1184   my $count_query = "SELECT COUNT(DISTINCT cust_main.custnum) FROM cust_main $addl_from $extra_sql";
1185
1186   if ($params->{'flattened_pkgs'}) {
1187
1188     #my $pkg_join = '';
1189     $addl_from .=
1190       ' LEFT JOIN cust_pkg ON ( cust_main.custnum = cust_pkg.custnum ) ';
1191
1192     if ($dbh->{Driver}->{Name} eq 'Pg') {
1193
1194       push @select, "
1195         ARRAY_TO_STRING(
1196           ARRAY(
1197             SELECT pkg FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart )
1198               WHERE cust_main.custnum = cust_pkg.custnum $pkgwhere
1199           ), '|'
1200         ) AS magic
1201       ";
1202
1203     } elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
1204       push @select, "GROUP_CONCAT(part_pkg.pkg SEPARATOR '|') as magic";
1205       $addl_from .= ' LEFT JOIN part_pkg USING ( pkgpart ) ';
1206       #$pkg_join  .= ' LEFT JOIN part_pkg USING ( pkgpart ) ';
1207     } else {
1208       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
1209            "omitting package information from report.";
1210     }
1211
1212     my $header_query = "
1213       SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count
1214         FROM cust_main $addl_from $extra_sql $pkgwhere
1215           GROUP BY cust_main.custnum ORDER BY count DESC LIMIT 1
1216     ";
1217
1218     my $sth = dbh->prepare($header_query) or die dbh->errstr;
1219     $sth->execute() or die $sth->errstr;
1220     my $headerrow = $sth->fetchrow_arrayref;
1221     my $headercount = $headerrow ? $headerrow->[0] : 0;
1222     while($headercount) {
1223       unshift @extra_headers, "Package ". $headercount;
1224       unshift @extra_fields, eval q!sub {my $c = shift;
1225                                          my @a = split '\|', $c->magic;
1226                                          my $p = $a[!.--$headercount. q!];
1227                                          $p;
1228                                         };!;
1229       unshift @extra_sort_fields, '';
1230     }
1231
1232   }
1233
1234   if ( $params->{'with_referrals'} ) {
1235
1236     #XXX next: num for each customer status
1237
1238     push @select,
1239       '( SELECT COUNT(*) FROM cust_main AS referred_cust_main
1240            WHERE cust_main.custnum = referred_cust_main.referral_custnum
1241        ) AS num_referrals';
1242
1243     unshift @extra_headers, 'Referrals';
1244     unshift @extra_fields, 'num_referrals';
1245     unshift @extra_sort_fields, 'num_referrals';
1246
1247   }
1248
1249   my $select = join(', ', @select);
1250
1251   my $sql_query = {
1252     'table'             => 'cust_main',
1253     'select'            => $select,
1254     'addl_from'         => $addl_from,
1255     'hashref'           => {},
1256     'extra_sql'         => $extra_sql,
1257     'order_by'          => $orderby,
1258     'count_query'       => $count_query,
1259     'extra_headers'     => \@extra_headers,
1260     'extra_fields'      => \@extra_fields,
1261     'extra_sort_fields' => \@extra_sort_fields,
1262   };
1263   #warn Data::Dumper::Dumper($sql_query);
1264   $sql_query;
1265
1266 }
1267
1268 =item fuzzy_search FUZZY_HASHREF [ OPTS ]
1269
1270 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
1271 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
1272 specified.
1273
1274 Additional options are the same as FS::Record::qsearch
1275
1276 =cut
1277
1278 sub fuzzy_search {
1279   my $self = shift;
1280   my $fuzzy = shift;
1281   # sensible defaults, then merge in any passed options
1282   my %fuzopts = (
1283     'table'     => 'cust_main',
1284     'addl_from' => '',
1285     'extra_sql' => '',
1286     'hashref'   => {},
1287     @_
1288   );
1289
1290   my @cust_main = ();
1291
1292   my @fuzzy_mod = 'i';
1293   my $conf = new FS::Conf;
1294   my $fuzziness = $conf->config('fuzzy-fuzziness');
1295   push @fuzzy_mod, $fuzziness if $fuzziness;
1296
1297   check_and_rebuild_fuzzyfiles();
1298   foreach my $field ( keys %$fuzzy ) {
1299
1300     my $all = $self->all_X($field);
1301     next unless scalar(@$all);
1302
1303     my %match = ();
1304     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, \@fuzzy_mod, @$all ) );
1305     next if !keys(%match);
1306
1307     my $in_matches = 'IN (' .
1308                      join(',', map { dbh->quote($_) } keys %match) .
1309                      ')';
1310
1311     my $extra_sql = $fuzopts{extra_sql};
1312     if ($extra_sql =~ /^\s*where /i or keys %{ $fuzopts{hashref} }) {
1313       $extra_sql .= ' AND ';
1314     } else {
1315       $extra_sql .= 'WHERE ';
1316     }
1317     $extra_sql .= "$field $in_matches";
1318
1319     my $addl_from = $fuzopts{addl_from};
1320     if ( $field =~ /^cust_location\./ ) {
1321       $addl_from .= ' JOIN cust_location USING (custnum)';
1322     } elsif ( $field =~ /^contact\./ ) {
1323       $addl_from .= ' JOIN contact USING (custnum)';
1324     }
1325
1326     push @cust_main, qsearch({
1327       %fuzopts,
1328       'addl_from' => $addl_from,
1329       'extra_sql' => $extra_sql,
1330     });
1331   }
1332
1333   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
1334   my %saw = ();
1335   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
1336
1337   @cust_main;
1338
1339 }
1340
1341 =back
1342
1343 =head1 UTILITY SUBROUTINES
1344
1345 =over 4
1346
1347 =item check_and_rebuild_fuzzyfiles
1348
1349 =cut
1350
1351 sub check_and_rebuild_fuzzyfiles {
1352   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1353   rebuild_fuzzyfiles()
1354     if grep { ! -e "$dir/$_" }
1355          map {
1356                my ($field, $table) = reverse split('\.', $_);
1357                $table ||= 'cust_main';
1358                "$table.$field"
1359              }
1360            @fuzzyfields;
1361 }
1362
1363 =item rebuild_fuzzyfiles
1364
1365 =cut
1366
1367 sub rebuild_fuzzyfiles {
1368
1369   use Fcntl qw(:flock);
1370
1371   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1372   mkdir $dir, 0700 unless -d $dir;
1373
1374   foreach my $fuzzy ( @fuzzyfields ) {
1375
1376     my ($field, $table) = reverse split('\.', $fuzzy);
1377     $table ||= 'cust_main';
1378
1379     open(LOCK,">>$dir/$table.$field")
1380       or die "can't open $dir/$table.$field: $!";
1381     flock(LOCK,LOCK_EX)
1382       or die "can't lock $dir/$table.$field: $!";
1383
1384     open (CACHE, '>:encoding(UTF-8)', "$dir/$table.$field.tmp")
1385       or die "can't open $dir/$table.$field.tmp: $!";
1386
1387     my $sth = dbh->prepare(
1388       "SELECT $field FROM $table WHERE $field IS NOT NULL AND $field != ''"
1389     );
1390     $sth->execute or die $sth->errstr;
1391
1392     while ( my $row = $sth->fetchrow_arrayref ) {
1393       print CACHE $row->[0]. "\n";
1394     }
1395
1396     close CACHE or die "can't close $dir/$table.$field.tmp: $!";
1397
1398     rename "$dir/$table.$field.tmp", "$dir/$table.$field";
1399     close LOCK;
1400   }
1401
1402 }
1403
1404 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
1405
1406 =cut
1407
1408 sub append_fuzzyfiles {
1409   #my( $first, $last, $company ) = @_;
1410
1411   check_and_rebuild_fuzzyfiles();
1412
1413   #foreach my $fuzzy (@fuzzyfields) {
1414   foreach my $fuzzy ( 'cust_main.first', 'cust_main.last', 'cust_main.company',
1415                       'cust_location.address1',
1416                       'cust_main.ship_company',
1417                     ) {
1418
1419     append_fuzzyfiles_fuzzyfield($fuzzy, shift);
1420
1421   }
1422
1423   1;
1424 }
1425
1426 =item append_fuzzyfiles_fuzzyfield COLUMN VALUE
1427
1428 =item append_fuzzyfiles_fuzzyfield TABLE.COLUMN VALUE
1429
1430 =cut
1431
1432 use Fcntl qw(:flock);
1433 sub append_fuzzyfiles_fuzzyfield {
1434   my( $fuzzyfield, $value ) = @_;
1435
1436   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1437
1438
1439   my ($field, $table) = reverse split('\.', $fuzzyfield);
1440   $table ||= 'cust_main';
1441
1442   return unless length($value);
1443
1444   open(CACHE, '>>:encoding(UTF-8)', "$dir/$table.$field" )
1445     or die "can't open $dir/$table.$field: $!";
1446   flock(CACHE,LOCK_EX)
1447     or die "can't lock $dir/$table.$field: $!";
1448
1449   print CACHE "$value\n";
1450
1451   flock(CACHE,LOCK_UN)
1452     or die "can't unlock $dir/$table.$field: $!";
1453   close CACHE;
1454
1455 }
1456
1457 =item all_X
1458
1459 =cut
1460
1461 sub all_X {
1462   my( $self, $fuzzy ) = @_;
1463   my ($field, $table) = reverse split('\.', $fuzzy);
1464   $table ||= 'cust_main';
1465
1466   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1467   open(CACHE, '<:encoding(UTF-8)', "$dir/$table.$field")
1468     or die "can't open $dir/$table.$field: $!";
1469   my @array = map { chomp; $_; } <CACHE>;
1470   close CACHE;
1471   \@array;
1472 }
1473
1474 =head1 BUGS
1475
1476 Bed bugs
1477
1478 =head1 SEE ALSO
1479
1480 L<FS::cust_main>, L<FS::Record>
1481
1482 =cut
1483
1484 1;
1485