continue sales person work: customer and package selection, commissions, reporting...
[freeside.git] / 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 = ( 'cust_main.first', 'cust_main.last', 'cust_main.company', 
23   'cust_location.address1' );
24
25 install_callback FS::UID sub { 
26   $conf = new FS::Conf;
27   #yes, need it for stuff below (prolly should be cached)
28 };
29
30 =head1 NAME
31
32 FS::cust_main::Search - Customer searching
33
34 =head1 SYNOPSIS
35
36   use FS::cust_main::Search;
37
38   FS::cust_main::Search::smart_search(%options);
39
40   FS::cust_main::Search::email_search(%options);
41
42   FS::cust_main::Search->search( \%options );
43   
44   FS::cust_main::Search->fuzzy_search( \%fuzzy_hashref );
45
46 =head1 SUBROUTINES
47
48 =over 4
49
50 =item smart_search OPTION => VALUE ...
51
52 Accepts the following options: I<search>, the string to search for.  The string
53 will be searched for as a customer number, phone number, name or company name,
54 address (if address1-search is on), invoicing email address, or credit card
55 number.
56
57 Searches match as an exact, or, in some cases, a substring or fuzzy match (see
58 the source code for the exact heuristics used); I<no_fuzzy_on_exact>, causes
59 smart_search to
60 skip fuzzy matching when an exact match is found.
61
62 Any additional options are treated as an additional qualifier on the search
63 (i.e. I<agentnum>).
64
65 Returns a (possibly empty) array of FS::cust_main objects.
66
67 =cut
68
69 sub smart_search {
70   my %options = @_;
71
72   #here is the agent virtualization
73   my $agentnums_sql = 
74     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
75
76   my @cust_main = ();
77
78   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
79   my $search = delete $options{'search'};
80   ( my $alphanum_search = $search ) =~ s/\W//g;
81   
82   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
83
84     #false laziness w/Record::ut_phone
85     my $phonen = "$1-$2-$3";
86     $phonen .= " x$4" if $4;
87
88     push @cust_main, qsearch( {
89       'table'   => 'cust_main',
90       'hashref' => { %options },
91       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
92                      ' ( '.
93                          join(' OR ', map "$_ = '$phonen'",
94                                           qw( daytime night mobile fax )
95                              ).
96                      ' ) '.
97                      " AND $agentnums_sql", #agent virtualization
98     } );
99
100     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
101       #try looking for matches with extensions unless one was specified
102
103       push @cust_main, qsearch( {
104         'table'   => 'cust_main',
105         'hashref' => { %options },
106         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
107                        ' ( '.
108                            join(' OR ', map "$_ LIKE '$phonen\%'",
109                                             qw( daytime night )
110                                ).
111                        ' ) '.
112                        " AND $agentnums_sql", #agent virtualization
113       } );
114
115     }
116
117   } 
118   
119   
120   if ( $search =~ /@/ ) { #invoicing email address
121       push @cust_main,
122           map $_->cust_main,
123               qsearch( {
124                          'table'     => 'cust_main_invoice',
125                          'hashref'   => { 'dest' => $search },
126                        }
127                      );
128
129   # custnum search (also try agent_custid), with some tweaking options if your
130   # legacy cust "numbers" have letters
131   } elsif ( $search =~ /^\s*(\d+)\s*$/
132          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
133               && $search =~ /^\s*(\w\w?\d+)\s*$/
134             )
135          || ( $conf->config('cust_main-custnum-display_special')
136            # it's not currently possible for special prefixes to contain
137            # digits, so just strip off any alphabetic prefix and match 
138            # the rest to custnum
139               && $search =~ /^\s*[[:alpha:]]*(\d+)\s*$/
140             )
141          || ( $conf->exists('address1-search' )
142               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
143             )
144      )
145   {
146
147     my $num = $1;
148
149     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
150       my $agent_custid_null = $conf->exists('cust_main-default_agent_custid')
151                                 ? ' AND agent_custid IS NULL ' : '';
152       push @cust_main, qsearch( {
153         'table'     => 'cust_main',
154         'hashref'   => { 'custnum' => $num, %options },
155         'extra_sql' => " AND $agentnums_sql $agent_custid_null",
156       } );
157     }
158
159     # for all agents this user can see, if any of them have custnum prefixes 
160     # that match the search string, include customers that match the rest 
161     # of the custnum and belong to that agent
162     foreach my $agentnum ( $FS::CurrentUser::CurrentUser->agentnums ) {
163       my $p = $conf->config('cust_main-custnum-display_prefix', $agentnum);
164       next if !$p;
165       if ( $p eq substr($num, 0, length($p)) ) {
166         push @cust_main, qsearch( {
167           'table'   => 'cust_main',
168           'hashref' => { 'custnum' => 0 + substr($num, length($p)),
169                          'agentnum' => $agentnum,
170                           %options,
171                        },
172         } );
173       }
174     }
175
176     push @cust_main, qsearch( {
177         'table'     => 'cust_main',
178         'hashref'   => { 'agent_custid' => $num, %options },
179         'extra_sql' => " AND $agentnums_sql", #agent virtualization
180     } );
181
182     if ( $conf->exists('address1-search') ) {
183       my $len = length($num);
184       $num = lc($num);
185       # probably the Right Thing: return customers that have any associated
186       # locations matching the string, not just bill/ship location
187       push @cust_main, qsearch( {
188         'table'     => 'cust_main',
189         'addl_from' => ' JOIN cust_location USING (custnum) ',
190         'hashref'   => { %options, },
191         'extra_sql' => 
192           ( keys(%options) ? ' AND ' : ' WHERE ' ).
193           " LOWER(SUBSTRING(cust_location.address1 FROM 1 FOR $len)) = '$num' ".
194           " AND $agentnums_sql",
195       } );
196     }
197
198   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
199
200     my($company, $last, $first) = ( $1, $2, $3 );
201
202     # "Company (Last, First)"
203     #this is probably something a browser remembered,
204     #so just do an exact search (but case-insensitive, so USPS standardization
205     #doesn't throw a wrench in the works)
206
207     push @cust_main, qsearch( {
208         'table'     => 'cust_main',
209         'hashref'   => { %options },
210         'extra_sql' => 
211         ( keys(%options) ? ' AND ' : ' WHERE ' ).
212         join(' AND ',
213           " LOWER(first)   = ". dbh->quote(lc($first)),
214           " LOWER(last)    = ". dbh->quote(lc($last)),
215           " LOWER(company) = ". dbh->quote(lc($company)),
216           $agentnums_sql,
217         ),
218       } ),
219     #contacts?
220
221   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
222                                               # try (ship_){last,company}
223
224     my $value = lc($1);
225
226     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
227     # # full strings the browser remembers won't work
228     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
229
230     use Lingua::EN::NameParse;
231     my $NameParse = new Lingua::EN::NameParse(
232              auto_clean     => 1,
233              allow_reversed => 1,
234     );
235
236     my($last, $first) = ( '', '' );
237     #maybe disable this too and just rely on NameParse?
238     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
239     
240       ($last, $first) = ( $1, $2 );
241     
242     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
243     } elsif ( ! $NameParse->parse($value) ) {
244
245       my %name = $NameParse->components;
246       $first = $name{'given_name_1'} || $name{'initials_1'}; #wtf NameParse, Ed?
247       $last  = $name{'surname_1'};
248
249     }
250
251     if ( $first && $last ) {
252
253       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
254
255       #exact
256       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
257       $sql .= "( LOWER(cust_main.last) = $q_last AND LOWER(cust_main.first) = $q_first )";
258
259       push @cust_main, qsearch( {
260         'table'     => 'cust_main',
261         'hashref'   => \%options,
262         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
263       } );
264       #contacts?
265
266       # or it just be something that was typed in... (try that in a sec)
267
268     }
269
270     my $q_value = dbh->quote($value);
271
272     #exact
273     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
274     $sql .= " (    LOWER(last)          = $q_value
275                 OR LOWER(company)       = $q_value
276             ";
277     #yes, it's a kludge
278     $sql .= "   OR EXISTS( 
279                 SELECT 1 FROM cust_location 
280                 WHERE LOWER(cust_location.address1) = $q_value
281                   AND cust_location.custnum = cust_main.custnum
282             )
283             "
284       if $conf->exists('address1-search');
285     $sql .= " )";
286
287     push @cust_main, qsearch( {
288       'table'     => 'cust_main',
289       'hashref'   => \%options,
290       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
291     } );
292
293     #no exact match, trying substring/fuzzy
294     #always do substring & fuzzy (unless they're explicity config'ed off)
295     #getting complaints searches are not returning enough
296     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
297
298       #still some false laziness w/search (was search/cust_main.cgi)
299
300       #substring
301
302       my @hashrefs = (
303         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
304       );
305
306       if ( $first && $last ) {
307         #contacts? ship_first/ship_last are gone
308
309         push @hashrefs,
310           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
311             'last'         => { op=>'ILIKE', value=>"%$last%" },
312           },
313         ;
314
315       } else {
316
317         push @hashrefs,
318           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
319         ;
320       }
321
322       foreach my $hashref ( @hashrefs ) {
323
324         push @cust_main, qsearch( {
325           'table'     => 'cust_main',
326           'hashref'   => { %$hashref,
327                            %options,
328                          },
329           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
330         } );
331
332       }
333
334       if ( $conf->exists('address1-search') ) {
335
336         push @cust_main, qsearch( {
337           'table'     => 'cust_main',
338           'addl_from' => 'JOIN cust_location USING (custnum)',
339           'extra_sql' => 'WHERE cust_location.address1 ILIKE '.
340                           dbh->quote("%$value%"),
341         } );
342
343       }
344
345       #fuzzy
346       my %fuzopts = (
347         'hashref'   => \%options,
348         'select'    => '',
349         'extra_sql' => "WHERE $agentnums_sql",    #agent virtualization
350       );
351
352       if ( $first && $last ) {
353         push @cust_main, FS::cust_main::Search->fuzzy_search(
354           { 'last'   => $last,    #fuzzy hashref
355             'first'  => $first }, #
356           %fuzopts
357         );
358       }
359       foreach my $field ( 'last', 'company' ) {
360         push @cust_main,
361           FS::cust_main::Search->fuzzy_search( { $field => $value }, %fuzopts );
362       }
363       if ( $conf->exists('address1-search') ) {
364         push @cust_main,
365           FS::cust_main::Search->fuzzy_search(
366             { 'cust_location.address1' => $value }, %fuzopts );
367       }
368
369     }
370
371   }
372
373   ( my $nospace_search = $search ) =~ s/\s//g;
374   ( my $card_search = $nospace_search ) =~ s/\-//g;
375   $card_search =~ s/[x\*\.\_]/x/gi;
376   
377   if ( $card_search =~ /^[\dx]{15,16}$/i ) { #credit card search
378
379     ( my $like_search = $card_search ) =~ s/x/_/g;
380     my $mask_search = FS::payinfo_Mixin->mask_payinfo('CARD', $card_search);
381
382     push @cust_main, qsearch({
383       'table'     => 'cust_main',
384       'hashref'   => {},
385       'extra_sql' => " WHERE (    payinfo LIKE '$like_search'
386                                OR paymask =    '$mask_search'
387                              ) ".
388                      " AND payby IN ('CARD','DCRD') ".
389                      " AND $agentnums_sql", #agent virtulization
390     });
391
392   }
393   
394
395   #eliminate duplicates
396   my %saw = ();
397   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
398
399   @cust_main;
400
401 }
402
403 =item email_search
404
405 Accepts the following options: I<email>, the email address to search for.  The
406 email address will be searched for as an email invoice destination and as an
407 svc_acct account.
408
409 #Any additional options are treated as an additional qualifier on the search
410 #(i.e. I<agentnum>).
411
412 Returns a (possibly empty) array of FS::cust_main objects (but usually just
413 none or one).
414
415 =cut
416
417 sub email_search {
418   my %options = @_;
419
420   local($DEBUG) = 1;
421
422   my $email = delete $options{'email'};
423
424   #we're only being used by RT at the moment... no agent virtualization yet
425   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
426
427   my @cust_main = ();
428
429   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
430
431     my ( $user, $domain ) = ( $1, $2 );
432
433     warn "$me smart_search: searching for $user in domain $domain"
434       if $DEBUG;
435
436     push @cust_main,
437       map $_->cust_main,
438           qsearch( {
439                      'table'     => 'cust_main_invoice',
440                      'hashref'   => { 'dest' => $email },
441                    }
442                  );
443
444     push @cust_main,
445       map  $_->cust_main,
446       grep $_,
447       map  $_->cust_svc->cust_pkg,
448           qsearch( {
449                      'table'     => 'svc_acct',
450                      'hashref'   => { 'username' => $user, },
451                      'extra_sql' =>
452                        'AND ( SELECT domain FROM svc_domain
453                                 WHERE svc_acct.domsvc = svc_domain.svcnum
454                             ) = '. dbh->quote($domain),
455                    }
456                  );
457   }
458
459   my %saw = ();
460   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
461
462   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
463     if $DEBUG;
464
465   @cust_main;
466
467 }
468
469 =back
470
471 =head1 CLASS METHODS
472
473 =over 4
474
475 =item search HASHREF
476
477 (Class method)
478
479 Returns a qsearch hash expression to search for parameters specified in
480 HASHREF.  Valid parameters are
481
482 =over 4
483
484 =item agentnum
485
486 =item status
487
488 =item address
489
490 =item zip
491
492 =item refnum
493
494 =item cancelled_pkgs
495
496 bool
497
498 =item signupdate
499
500 listref of start date, end date
501
502 =item birthdate
503
504 listref of start date, end date
505
506 =item spouse_birthdate
507
508 listref of start date, end date
509
510 =item anniversary_date
511
512 listref of start date, end date
513
514 =item payby
515
516 listref
517
518 =item paydate_year
519
520 =item paydate_month
521
522 =item current_balance
523
524 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
525
526 =item cust_fields
527
528 =item flattened_pkgs
529
530 bool
531
532 =back
533
534 =cut
535
536 sub search {
537   my ($class, $params) = @_;
538
539   my $dbh = dbh;
540
541   my @where = ();
542   my $orderby;
543
544   # initialize these to prevent warnings
545   $params = {
546     'custnum'       => '',
547     'agentnum'      => '',
548     'usernum'       => '',
549     'status'        => '',
550     'address'       => '',
551     'zip'           => '',
552     'paydate_year'  => '',
553     'invoice_terms' => '',
554     'custbatch'     => '',
555     %$params
556   };
557
558   ##
559   # explicit custnum(s)
560   ##
561
562   if ( $params->{'custnum'} ) {
563     my @custnums = ref($params->{'custnum'}) ? 
564                       @{ $params->{'custnum'} } : 
565                       $params->{'custnum'};
566     push @where, 
567       'cust_main.custnum IN (' . 
568       join(',', map { $_ =~ /^(\d+)$/ ? $1 : () } @custnums ) .
569       ')' if scalar(@custnums) > 0;
570   }
571
572   ##
573   # parse agent
574   ##
575
576   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
577     push @where,
578       "cust_main.agentnum = $1";
579   }
580
581   ##
582   # do the same for user
583   ##
584
585   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
586     push @where,
587       "cust_main.usernum = $1";
588   }
589
590   ##
591   # parse status
592   ##
593
594   #prospect ordered active inactive suspended cancelled
595   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
596     my $method = $params->{'status'}. '_sql';
597     #push @where, $class->$method();
598     push @where, FS::cust_main->$method();
599   }
600
601   ##
602   # address
603   ##
604   if ( $params->{'address'} =~ /\S/ ) {
605     my $address = dbh->quote('%'. lc($params->{'address'}). '%');
606     push @where, "EXISTS(
607       SELECT 1 FROM cust_location 
608       WHERE cust_location.custnum = cust_main.custnum
609         AND (LOWER(cust_location.address1) LIKE $address OR
610              LOWER(cust_location.address2) LIKE $address)
611     )";
612   }
613
614   ##
615   # zipcode
616   ##
617   if ( $params->{'zip'} =~ /\S/ ) {
618     my $zip = dbh->quote($params->{'zip'} . '%');
619     push @where, "EXISTS(
620       SELECT 1 FROM cust_location
621       WHERE cust_location.custnum = cust_main.custnum
622         AND cust_location.zip LIKE $zip
623     )";
624   }
625
626   ###
627   # refnum
628   ###
629   if ( $params->{'refnum'}  ) {
630
631     my @refnum = ref( $params->{'refnum'} )
632                    ? @{ $params->{'refnum'} }
633                    :  ( $params->{'refnum'} );
634
635     @refnum = grep /^(\d*)$/, @refnum;
636
637     push @where, '( '. join(' OR ', map "cust_main.refnum = $_", @refnum ). ' )'
638       if @refnum;
639
640   }
641
642   ##
643   # parse cancelled package checkbox
644   ##
645
646   my $pkgwhere = "";
647
648   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
649     unless $params->{'cancelled_pkgs'};
650
651   ##
652   # parse without census tract checkbox
653   ##
654
655   push @where, "(ship_location.censustract = '' or ship_location.censustract is null)"
656     if $params->{'no_censustract'};
657
658   ##
659   # parse with hardcoded tax location checkbox
660   ##
661
662   push @where, "ship_location.geocode is not null"
663     if $params->{'with_geocode'};
664
665   ##
666   # "with email address(es)" checkbox
667   ##
668
669   push @where,
670     'EXISTS ( SELECT 1 FROM cust_main_invoice
671                 WHERE cust_main_invoice.custnum = cust_main.custnum
672                   AND length(dest) > 5
673             )'  # AND dest LIKE '%@%'
674     if $params->{'with_email'};
675
676   ##
677   # "with postal mail invoices" checkbox
678   ##
679
680   push @where,
681     "EXISTS ( SELECT 1 FROM cust_main_invoice
682                 WHERE cust_main_invoice.custnum = cust_main.custnum
683                   AND dest = 'POST' )"
684     if $params->{'POST'};
685
686   ##
687   # "without postal mail invoices" checkbox
688   ##
689
690   push @where,
691     "NOT EXISTS ( SELECT 1 FROM cust_main_invoice
692                     WHERE cust_main_invoice.custnum = cust_main.custnum
693                       AND dest = 'POST' )"
694     if $params->{'no_POST'};
695
696   ##
697   # dates
698   ##
699
700   foreach my $field (qw( signupdate birthdate spouse_birthdate anniversary_date )) {
701
702     next unless exists($params->{$field});
703
704     my($beginning, $ending, $hour) = @{$params->{$field}};
705
706     push @where,
707       "cust_main.$field IS NOT NULL",
708       "cust_main.$field >= $beginning",
709       "cust_main.$field <= $ending";
710
711     if($field eq 'signupdate' && defined $hour) {
712       if ($dbh->{Driver}->{Name} =~ /Pg/i) {
713         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
714       }
715       elsif( $dbh->{Driver}->{Name} =~ /mysql/i) {
716         push @where, "hour(from_unixtime(cust_main.$field)) = $hour"
717       }
718       else {
719         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
720       }
721     }
722
723     $orderby ||= "ORDER BY cust_main.$field";
724
725   }
726
727   ###
728   # classnum
729   ###
730
731   if ( $params->{'classnum'} ) {
732
733     my @classnum = ref( $params->{'classnum'} )
734                      ? @{ $params->{'classnum'} }
735                      :  ( $params->{'classnum'} );
736
737     @classnum = grep /^(\d*)$/, @classnum;
738
739     if ( @classnum ) {
740       push @where, '( '. join(' OR ', map {
741                                             $_ ? "cust_main.classnum = $_"
742                                                : "cust_main.classnum IS NULL"
743                                           }
744                                           @classnum
745                              ).
746                    ' )';
747     }
748
749   }
750
751   ###
752   # payby
753   ###
754
755   if ( $params->{'payby'} ) {
756
757     my @payby = ref( $params->{'payby'} )
758                   ? @{ $params->{'payby'} }
759                   :  ( $params->{'payby'} );
760
761     @payby = grep /^([A-Z]{4})$/, @payby;
762
763     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
764       if @payby;
765
766   }
767
768   ###
769   # paydate_year / paydate_month
770   ###
771
772   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
773     my $year = $1;
774     $params->{'paydate_month'} =~ /^(\d\d?)$/
775       or die "paydate_year without paydate_month?";
776     my $month = $1;
777
778     push @where,
779       'paydate IS NOT NULL',
780       "paydate != ''",
781       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
782 ;
783   }
784
785   ###
786   # invoice terms
787   ###
788
789   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
790     my $terms = $1;
791     if ( $1 eq 'NULL' ) {
792       push @where,
793         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
794     } else {
795       push @where,
796         "cust_main.invoice_terms IS NOT NULL",
797         "cust_main.invoice_terms = '$1'";
798     }
799   }
800
801   ##
802   # amounts
803   ##
804
805   if ( $params->{'current_balance'} ) {
806
807     #my $balance_sql = $class->balance_sql();
808     my $balance_sql = FS::cust_main->balance_sql();
809
810     my @current_balance =
811       ref( $params->{'current_balance'} )
812       ? @{ $params->{'current_balance'} }
813       :  ( $params->{'current_balance'} );
814
815     push @where, map { s/current_balance/$balance_sql/; $_ }
816                      @current_balance;
817
818   }
819
820   ##
821   # custbatch
822   ##
823
824   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
825     push @where,
826       "cust_main.custbatch = '$1'";
827   }
828   
829   if ( $params->{'tagnum'} ) {
830     my @tagnums = ref( $params->{'tagnum'} ) ? @{ $params->{'tagnum'} } : ( $params->{'tagnum'} );
831
832     @tagnums = grep /^(\d+)$/, @tagnums;
833
834     if ( @tagnums ) {
835       if ( $params->{'all_tags'} ) {
836         foreach ( @tagnums ) {
837           push @where, 'exists(select 1 from cust_tag where '.
838                        'cust_tag.custnum = cust_main.custnum and tagnum = '.
839                        $_ . ')';
840         }
841       } else { # matching any tag, not all
842         my $tags_where = "0 < (select count(1) from cust_tag where " 
843                 . " cust_tag.custnum = cust_main.custnum and tagnum in ("
844                 . join(',', @tagnums) . "))";
845
846         push @where, $tags_where;
847       }
848     }
849   }
850
851
852   ##
853   # setup queries, subs, etc. for the search
854   ##
855
856   $orderby ||= 'ORDER BY custnum';
857
858   # here is the agent virtualization
859   push @where,
860     $FS::CurrentUser::CurrentUser->agentnums_sql(table => 'cust_main');
861
862   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
863
864   my $addl_from = '';
865   # always make address fields available in results
866   for my $pre ('bill_', 'ship_') {
867     $addl_from .= 
868       'LEFT JOIN cust_location AS '.$pre.'location '.
869       'ON (cust_main.'.$pre.'locationnum = '.$pre.'location.locationnum) ';
870   }
871
872   my $count_query = "SELECT COUNT(*) FROM cust_main $addl_from $extra_sql";
873
874   my @select = (
875                  'cust_main.custnum',
876                  # there's a good chance that we'll need these
877                  'cust_main.bill_locationnum',
878                  'cust_main.ship_locationnum',
879                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
880                );
881
882   my(@extra_headers) = ();
883   my(@extra_fields)  = ();
884
885   if ($params->{'flattened_pkgs'}) {
886
887     #my $pkg_join = '';
888     $addl_from .=
889       ' LEFT JOIN cust_pkg ON ( cust_main.custnum = cust_pkg.custnum ) ';
890
891     if ($dbh->{Driver}->{Name} eq 'Pg') {
892
893       push @select, "
894         ARRAY_TO_STRING(
895           ARRAY(
896             SELECT pkg FROM cust_pkg LEFT JOIN part_pkg USING ( pkgpart )
897               WHERE cust_main.custnum = cust_pkg.custnum $pkgwhere
898           ), '|'
899         ) AS magic
900       ";
901
902     } elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
903       push @select, "GROUP_CONCAT(part_pkg.pkg SEPARATOR '|') as magic";
904       $addl_from .= ' LEFT JOIN part_pkg USING ( pkgpart ) ';
905       #$pkg_join  .= ' LEFT JOIN part_pkg USING ( pkgpart ) ';
906     } else {
907       warn "warning: unknown database type ". $dbh->{Driver}->{Name}. 
908            "omitting package information from report.";
909     }
910
911     my $header_query = "
912       SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count
913         FROM cust_main $addl_from $extra_sql $pkgwhere
914           GROUP BY cust_main.custnum ORDER BY count DESC LIMIT 1
915     ";
916
917     my $sth = dbh->prepare($header_query) or die dbh->errstr;
918     $sth->execute() or die $sth->errstr;
919     my $headerrow = $sth->fetchrow_arrayref;
920     my $headercount = $headerrow ? $headerrow->[0] : 0;
921     while($headercount) {
922       unshift @extra_headers, "Package ". $headercount;
923       unshift @extra_fields, eval q!sub {my $c = shift;
924                                          my @a = split '\|', $c->magic;
925                                          my $p = $a[!.--$headercount. q!];
926                                          $p;
927                                         };!;
928     }
929
930   }
931
932   if ( $params->{'with_geocode'} ) {
933
934     unshift @extra_headers, 'Tax location override', 'Calculated tax location';
935     unshift @extra_fields, sub { my $c = shift; $c->get('geocode'); },
936                            sub { my $c = shift;
937                                  $c->set('geocode', '');
938                                  $c->geocode('cch'); #XXX only cch right now
939                                };
940     push @select, 'geocode';
941     push @select, 'zip' unless grep { $_ eq 'zip' } @select;
942     push @select, 'ship_zip' unless grep { $_ eq 'ship_zip' } @select;
943   }
944
945   my $select = join(', ', @select);
946
947   my $sql_query = {
948     'table'         => 'cust_main',
949     'select'        => $select,
950     'addl_from'     => $addl_from,
951     'hashref'       => {},
952     'extra_sql'     => $extra_sql,
953     'order_by'      => $orderby,
954     'count_query'   => $count_query,
955     'extra_headers' => \@extra_headers,
956     'extra_fields'  => \@extra_fields,
957   };
958   warn Data::Dumper::Dumper($sql_query);
959   $sql_query;
960
961 }
962
963 =item fuzzy_search FUZZY_HASHREF [ OPTS ]
964
965 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
966 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
967 specified.
968
969 Additional options are the same as FS::Record::qsearch
970
971 =cut
972
973 sub fuzzy_search {
974   my $self = shift;
975   my $fuzzy = shift;
976   # sensible defaults, then merge in any passed options
977   my %fuzopts = (
978     'table'     => 'cust_main',
979     'addl_from' => '',
980     'extra_sql' => '',
981     'hashref'   => {},
982     @_
983   );
984
985   my @cust_main = ();
986
987   my @fuzzy_mod = 'i';
988   my $conf = new FS::Conf;
989   my $fuzziness = $conf->config('fuzzy-fuzziness');
990   push @fuzzy_mod, $fuzziness if $fuzziness;
991
992   check_and_rebuild_fuzzyfiles();
993   foreach my $field ( keys %$fuzzy ) {
994
995     my $all = $self->all_X($field);
996     next unless scalar(@$all);
997
998     my %match = ();
999     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, \@fuzzy_mod, @$all ) );
1000     next if !keys(%match);
1001
1002     my $in_matches = 'IN (' .
1003                      join(',', map { dbh->quote($_) } keys %match) .
1004                      ')';
1005
1006     my $extra_sql = $fuzopts{extra_sql};
1007     if ($extra_sql =~ /^\s*where /i or keys %{ $fuzopts{hashref} }) {
1008       $extra_sql .= ' AND ';
1009     } else {
1010       $extra_sql .= 'WHERE ';
1011     }
1012     $extra_sql .= "$field $in_matches";
1013
1014     my $addl_from = $fuzopts{addl_from};
1015     if ( $field =~ /^cust_location/ ) {
1016       $addl_from .= ' JOIN cust_location USING (custnum)';
1017     }
1018
1019     push @cust_main, qsearch({
1020       %fuzopts,
1021       'addl_from' => $addl_from,
1022       'extra_sql' => $extra_sql,
1023     });
1024   }
1025
1026   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
1027   my %saw = ();
1028   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
1029
1030   @cust_main;
1031
1032 }
1033
1034 =back
1035
1036 =head1 UTILITY SUBROUTINES
1037
1038 =over 4
1039
1040 =item check_and_rebuild_fuzzyfiles
1041
1042 =cut
1043
1044 sub check_and_rebuild_fuzzyfiles {
1045   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1046   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields;
1047 }
1048
1049 =item rebuild_fuzzyfiles
1050
1051 =cut
1052
1053 sub rebuild_fuzzyfiles {
1054
1055   use Fcntl qw(:flock);
1056
1057   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1058   mkdir $dir, 0700 unless -d $dir;
1059
1060   foreach my $fuzzy ( @fuzzyfields ) {
1061
1062     my ($field, $table) = reverse split('\.', $fuzzy);
1063     $table ||= 'cust_main';
1064
1065     open(LOCK,">>$dir/$table.$field")
1066       or die "can't open $dir/$table.$field: $!";
1067     flock(LOCK,LOCK_EX)
1068       or die "can't lock $dir/$table.$field: $!";
1069
1070     open (CACHE, '>:encoding(UTF-8)', "$dir/$table.$field.tmp")
1071       or die "can't open $dir/$table.$field.tmp: $!";
1072
1073     my $sth = dbh->prepare(
1074       "SELECT $field FROM $table WHERE $field IS NOT NULL AND $field != ''"
1075     );
1076     $sth->execute or die $sth->errstr;
1077
1078     while ( my $row = $sth->fetchrow_arrayref ) {
1079       print CACHE $row->[0]. "\n";
1080     }
1081
1082     close CACHE or die "can't close $dir/$table.$field.tmp: $!";
1083   
1084     rename "$dir/$table.$field.tmp", "$dir/$table.$field";
1085     close LOCK;
1086   }
1087
1088 }
1089
1090 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
1091
1092 =cut
1093
1094 sub append_fuzzyfiles {
1095   #my( $first, $last, $company ) = @_;
1096
1097   check_and_rebuild_fuzzyfiles();
1098
1099   use Fcntl qw(:flock);
1100
1101   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1102
1103   foreach my $fuzzy (@fuzzyfields) {
1104
1105     my ($field, $table) = reverse split('\.', $fuzzy);
1106     $table ||= 'cust_main';
1107
1108     my $value = shift;
1109
1110     if ( $value ) {
1111
1112       open(CACHE, '>>:encoding(UTF-8)', "$dir/$table.$field" )
1113         or die "can't open $dir/$table.$field: $!";
1114       flock(CACHE,LOCK_EX)
1115         or die "can't lock $dir/$table.$field: $!";
1116
1117       print CACHE "$value\n";
1118
1119       flock(CACHE,LOCK_UN)
1120         or die "can't unlock $dir/$table.$field: $!";
1121       close CACHE;
1122     }
1123
1124   }
1125
1126   1;
1127 }
1128
1129 =item all_X
1130
1131 =cut
1132
1133 sub all_X {
1134   my( $self, $fuzzy ) = @_;
1135   my ($field, $table) = reverse split('\.', $fuzzy);
1136   $table ||= 'cust_main';
1137
1138   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
1139   open(CACHE, '<:encoding(UTF-8)', "$dir/$table.$field")
1140     or die "can't open $dir/$table.$field: $!";
1141   my @array = map { chomp; $_; } <CACHE>;
1142   close CACHE;
1143   \@array;
1144 }
1145
1146 =head1 BUGS
1147
1148 Bed bugs
1149
1150 =head1 SEE ALSO
1151
1152 L<FS::cust_main>, L<FS::Record>
1153
1154 =cut
1155
1156 1;
1157