htdocs/search/cust_main.cgi

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