htdocs/search/cust_main.cgi

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: cust_main.cgi,v 1.9 1999-02-28 00:03:55 ivan Exp $
   4 #
   5 # Usage: post form to:
   6 #        http://server.name/path/cust_main.cgi
   7 #
   8 # ivan@voicenet.com 96-dec-12
   9 #
  10 # rewrite ivan@sisd.com 98-mar-4
  11 #
  12 # now does browsing too ivan@sisd.com 98-mar-6
  13 #
  14 # Changes to allow page to work at a relative position in server
  15 #       bmccane@maxbaud.net     98-apr-3
  16 #
  17 # display total, use FS::CGI ivan@sisd.com 98-jul-17
  18 #
  19 # $Log: cust_main.cgi,v $
  20 # Revision 1.9  1999-02-28 00:03:55  ivan
  21 # removed misleading comments
  22 #
  23 # Revision 1.8  1999/02/07 09:59:36  ivan
  24 # more mod_perl fixes, and bugfixes Peter Wemm sent via email
  25 #
  26 # Revision 1.7  1999/01/25 12:19:11  ivan
  27 # yet more mod_perl stuff
  28 #
  29 # Revision 1.6  1999/01/19 05:14:12  ivan
  30 # for mod_perl: no more top-level my() variables; use vars instead
  31 # also the last s/create/new/;
  32 #
  33 # Revision 1.5  1999/01/18 09:41:37  ivan
  34 # all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
  35 # (good idea anyway)
  36 #
  37 # Revision 1.4  1998/12/30 00:57:50  ivan
  38 # bug
  39 #
  40 # Revision 1.3  1998/12/17 09:41:08  ivan
  41 # s/CGI::(Base|Request)/CGI.pm/;
  42 #
  43 # Revision 1.2  1998/11/12 08:10:22  ivan
  44 # CGI.pm instead of CGI-modules
  45 # relative URLs using popurl
  46 # got rid of lots of little tables
  47 # s/agrep/String::Approx/;
  48 # bubble up packages and services and link (slow)
  49 #
  50
  51 use strict;
  52 use vars qw(%ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby );
  53 use CGI;
  54 use CGI::Carp qw(fatalsToBrowser);
  55 use IO::Handle;
  56 use String::Approx qw(amatch);
  57 use FS::UID qw(cgisuidsetup);
  58 use FS::Record qw(qsearch qsearchs);
  59 use FS::CGI qw(header menubar eidiot popurl table);
  60 use FS::cust_main;
  61
  62 $cgi = new CGI;
  63 cgisuidsetup($cgi);
  64
  65 if ( $cgi->keywords ) {
  66   my($query)=$cgi->keywords;
  67   if ( $query eq 'custnum' ) {
  68     $sortby=\*custnum_sort;
  69     @cust_main=qsearch('cust_main',{});
  70   } elsif ( $query eq 'last' ) {
  71     $sortby=\*last_sort;
  72     @cust_main=qsearch('cust_main',{});
  73   } elsif ( $query eq 'company' ) {
  74     $sortby=\*company_sort;
  75     @cust_main=qsearch('cust_main',{});
  76   }
  77 } else {
  78   &cardsearch if ( $cgi->param('card_on') && $cgi->param('card') );
  79   &lastsearch if ( $cgi->param('last_on') && $cgi->param('last_text') );
  80   &companysearch if ( $cgi->param('company_on') && $cgi->param('company_text') );
  81 }
  82
  83 #%ncancelled_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main;
  84 %all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main;
  85
  86 if ( scalar(@cust_main) == 1 ) {
  87   print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum);
  88   exit;
  89 } elsif ( scalar(@cust_main) == 0 ) {
  90   eidiot "No matching customers found!\n";
  91 } else {
  92
  93   my($total)=scalar(@cust_main);
  94   print $cgi->header( '-expires' => 'now' ), header("Customer Search Results",menubar(
  95     'Main Menu', popurl(2)
  96   )), "$total matching customers found<BR>", table, <<END;
  97       <TR>
  98         <TH></TH>
  99         <TH>Contact name</TH>
 100         <TH>Company</TH>
 101         <TH>Packages</TH>
 102         <TH COLSPAN=2>Services</TH>
 103       </TR>
 104 END
 105
 106   my(%saw,$cust_main);
 107   foreach $cust_main (
 108     sort $sortby grep(!$saw{$_->custnum}++, @cust_main)
 109   ) {
 110     my($custnum,$last,$first,$company)=(
 111       $cust_main->custnum,
 112       $cust_main->getfield('last'),
 113       $cust_main->getfield('first'),
 114       $cust_main->company,
 115     );
 116
 117     my(@lol_cust_svc);
 118     my($rowspan)=0;#scalar( @{$all_pkgs{$custnum}} );
 119     foreach ( @{$all_pkgs{$custnum}} ) {
 120       my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
 121       push @lol_cust_svc, \@cust_svc;
 122       $rowspan += scalar(@cust_svc) || 1;
 123     }
 124
 125     #my($rowspan) = scalar(@{$all_pkgs{$custnum}});
 126     my($view) = popurl(2). "view/cust_main.cgi?$custnum";
 127     print <<END;
 128     <TR>
 129       <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$custnum</FONT></A></TD>
 130       <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$last, $first</FONT></A></TD>
 131       <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$company</FONT></A></TD>
 132 END
 133
 134     my($n1)='';
 135     foreach ( @{$all_pkgs{$custnum}} ) {
 136       my($pkgnum) = ($_->pkgnum);
 137       my($pkg) = $_->part_pkg->pkg;
 138       my $comment = $_->part_pkg->comment;
 139       my($pkgview) = popurl(2). "/view/cust_pkg.cgi?$pkgnum";
 140       #my(@cust_svc) = shift @lol_cust_svc;
 141       my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
 142       my($rowspan) = scalar(@cust_svc) || 1;
 143
 144       print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview"><FONT SIZE=-1>$pkg - $comment</FONT></A></TD>!;
 145       my($n2)='';
 146       foreach my $cust_svc ( @cust_svc ) {
 147          my($label, $value, $svcdb) = $cust_svc->label;
 148          my($svcnum) = $cust_svc->svcnum;
 149          my($sview) = popurl(2). "/view";
 150          print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!,
 151                qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!;
 152          $n2="</TR><TR>";
 153       }
 154       #print qq!</TR><TR>\n!;
 155       $n1="</TR><TR>";
 156     }
 157     print "<\TR>";
 158   }
 159
 160   print <<END;
 161     </TABLE>
 162   </BODY>
 163 </HTML>
 164 END
 165
 166 }
 167
 168 #
 169
 170 sub last_sort {
 171   $a->getfield('last') cmp $b->getfield('last');
 172 }
 173
 174 sub company_sort {
 175   return -1 if $a->company && ! $b->company;
 176   return 1 if ! $a->company && $b->company;
 177   $a->getfield('company') cmp $b->getfield('company');
 178 }
 179
 180 sub custnum_sort {
 181   $a->getfield('custnum') <=> $b->getfield('custnum');
 182 }
 183
 184 sub cardsearch {
 185
 186   my($card)=$cgi->param('card');
 187   $card =~ s/\D//g;
 188   $card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n";
 189   my($payinfo)=$1;
 190
 191   push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
 192
 193 }
 194
 195 sub lastsearch {
 196   my(%last_type);
 197   foreach ( $cgi->param('last_type') ) {
 198     $last_type{$_}++;
 199   }
 200
 201   $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/
 202     or eidiot "Illegal last name";
 203   my($last)=$1;
 204
 205   if ( $last_type{'Exact'}
 206        && ! $last_type{'Fuzzy'}
 207      #  && ! $last_type{'Sound-alike'}
 208   ) {
 209
 210     push @cust_main, qsearch('cust_main',{'last'=>$last});
 211
 212   } else {
 213
 214     my(%last);
 215
 216     my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{});
 217     if ($last_type{'Fuzzy'}) {
 218       foreach ( amatch($last, [ qw(i) ], @all_last) ) {
 219         $last{$_}++;
 220       }
 221     }
 222
 223     #if ($last_type{'Sound-alike'}) {
 224     #}
 225
 226     foreach ( keys %last ) {
 227       push @cust_main, qsearch('cust_main',{'last'=>$_});
 228     }
 229
 230   }
 231   $sortby=\*last_sort;
 232 }
 233
 234 sub companysearch {
 235
 236   my(%company_type);
 237   foreach ( $cgi->param('company_type') ) {
 238     $company_type{$_}++
 239   };
 240
 241   $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/
 242     or eidiot "Illegal company";
 243   my($company)=$1;
 244
 245   if ( $company_type{'Exact'}
 246        && ! $company_type{'Fuzzy'}
 247      #  && ! $company_type{'Sound-alike'}
 248   ) {
 249
 250     push @cust_main, qsearch('cust_main',{'company'=>$company});
 251
 252   } else {
 253
 254     my(%company);
 255     my(@all_company)=map $_->company, qsearch('cust_main',{});
 256
 257     if ($company_type{'Fuzzy'}) {
 258       foreach ( amatch($company, [ qw(i) ], @all_company ) ) {
 259         $company{$_}++;
 260       }
 261     }
 262
 263     #if ($company_type{'Sound-alike'}) {
 264     #}
 265
 266     foreach ( keys %company ) {
 267       push @cust_main, qsearch('cust_main',{'company'=>$_});
 268     }
 269
 270   }
 271   $sortby=\*company_sort;
 272
 273 }