htdocs/edit/cust_pkg.cgi

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: cust_pkg.cgi,v 1.5 1999-02-07 09:59:18 ivan Exp $
   4 #
   5 # this is for changing packages around, not editing things within the package
   6 #
   7 # Usage: cust_pkg.cgi custnum
   8 #        http://server.name/path/cust_pkg.cgi?custnum
   9 #
  10 # Note: Should be run setuid freeside as user nobody
  11 #
  12 # started with /sales/add/cust_pkg.cgi, which added packages
  13 # ivan@voicenet.com 97-jan-5, 97-mar-21
  14 #
  15 # Rewrote for new API
  16 # ivan@voicenet.com 97-jul-7
  17 #
  18 # FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
  19 #
  20 # Changes to allow page to work at a relative position in server
  21 # Changed to display packages 2-wide in a table
  22 #       bmccane@maxbaud.net     98-apr-3
  23 #
  24 # fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
  25 # 98-jun-1
  26 #
  27 # $Log: cust_pkg.cgi,v $
  28 # Revision 1.5  1999-02-07 09:59:18  ivan
  29 # more mod_perl fixes, and bugfixes Peter Wemm sent via email
  30 #
  31 # Revision 1.4  1999/01/19 05:13:38  ivan
  32 # for mod_perl: no more top-level my() variables; use vars instead
  33 # also the last s/create/new/;
  34 #
  35 # Revision 1.3  1999/01/18 09:41:28  ivan
  36 # all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
  37 # (good idea anyway)
  38 #
  39 # Revision 1.2  1998/12/17 06:17:04  ivan
  40 # fix double // in relative URLs, s/CGI::Base/CGI/;
  41 #
  42
  43 use strict;
  44 use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg
  45              $cust_main $agent $type_pkgs $count %remove_pkg );
  46 use CGI;
  47 use CGI::Carp qw(fatalsToBrowser);
  48 use FS::UID qw(cgisuidsetup);
  49 use FS::Record qw(qsearch qsearchs);
  50 use FS::CGI qw(header popurl);
  51 use FS::part_pkg;
  52 use FS::type_pkgs;
  53
  54 foreach (qsearch('part_pkg', {})) {
  55   $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
  56   $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
  57 }
  58
  59 $cgi = new CGI;
  60 &cgisuidsetup($cgi);
  61
  62 if ( $cgi->param('error') ) {
  63   $custnum = $cgi->param('custnum');
  64   %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg');
  65 } else {
  66   my($query) = $cgi->keywords;
  67   $query =~ /^(\d+)$/;
  68   $custnum = $1;
  69   undef %remove_pkg;
  70 }
  71
  72 $p1 = popurl(1);
  73 print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", '');
  74
  75 print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
  76       "</FONT>"
  77   if $cgi->param('error');
  78
  79 print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!;
  80
  81 print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
  82
  83 #current packages
  84 @cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } );
  85
  86 if (@cust_pkg) {
  87   print <<END;
  88 Current packages - select to remove (services are moved to a new package below)
  89 <BR><BR>
  90 END
  91
  92   my ($count) = 0 ;
  93   print qq!<TABLE>! ;
  94   foreach (@cust_pkg) {
  95     print '<TR>' if $count == 0;
  96     my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
  97     print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!;
  98     print " CHECKED" if $remove_pkg{$pkgnum};
  99     print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
 100     $count ++ ;
 101     if ($count == 2)
 102     {
 103       $count = 0 ;
 104       print qq!</TR>\n! ;
 105     }
 106   }
 107   print qq!</TABLE><BR><BR>!;
 108 }
 109
 110 print <<END;
 111 Order new packages<BR><BR>
 112 END
 113
 114 $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
 115 $agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
 116
 117 $count = 0 ;
 118 print qq!<TABLE>! ;
 119 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
 120   my($pkgpart)=$type_pkgs->pkgpart;
 121   print qq!<TR>! if ($count == 0) ;
 122   my $value = $cgi->param("pkg$pkgpart") || 0;
 123   print <<END;
 124   <TD>
 125   <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2">
 126   $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
 127 END
 128   $count ++ ;
 129   if ($count == 2)
 130   {
 131     print qq!</TR>\n! ;
 132     $count = 0 ;
 133   }
 134 }
 135 print qq!</TABLE>! ;
 136
 137 #submit
 138 print qq!<P><INPUT TYPE="submit" VALUE="Order">\n!;
 139
 140 print <<END;
 141     </FORM>
 142   </BODY>
 143 </HTML>
 144 END