htdocs/edit/cust_pkg.cgi

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: cust_pkg.cgi,v 1.8 1999-07-21 07:34:13 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 # started with /sales/add/cust_pkg.cgi, which added packages
  11 # ivan@voicenet.com 97-jan-5, 97-mar-21
  12 #
  13 # Rewrote for new API
  14 # ivan@voicenet.com 97-jul-7
  15 #
  16 # FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
  17 #
  18 # Changes to allow page to work at a relative position in server
  19 # Changed to display packages 2-wide in a table
  20 #       bmccane@maxbaud.net     98-apr-3
  21 #
  22 # fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
  23 # 98-jun-1
  24 #
  25 # $Log: cust_pkg.cgi,v $
  26 # Revision 1.8  1999-07-21 07:34:13  ivan
  27 # links to package browse and agent type edit if there aren't any packages to
  28 # order.  thanks to "Tech Account" <techy@orac.hq.org>
  29 #
  30 # Revision 1.7  1999/04/14 01:03:01  ivan
  31 # oops, in 1.2 tree, can't do searches until [cgi|admin]suidsetup,
  32 # bug is hidden by mod_perl persistance
  33 #
  34 # Revision 1.6  1999/02/28 00:03:36  ivan
  35 # removed misleading comments
  36 #
  37 # Revision 1.5  1999/02/07 09:59:18  ivan
  38 # more mod_perl fixes, and bugfixes Peter Wemm sent via email
  39 #
  40 # Revision 1.4  1999/01/19 05:13:38  ivan
  41 # for mod_perl: no more top-level my() variables; use vars instead
  42 # also the last s/create/new/;
  43 #
  44 # Revision 1.3  1999/01/18 09:41:28  ivan
  45 # all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
  46 # (good idea anyway)
  47 #
  48 # Revision 1.2  1998/12/17 06:17:04  ivan
  49 # fix double // in relative URLs, s/CGI::Base/CGI/;
  50 #
  51
  52 use strict;
  53 use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg
  54              $cust_main $agent $type_pkgs $count %remove_pkg $pkgparts );
  55 use CGI;
  56 use CGI::Carp qw(fatalsToBrowser);
  57 use FS::UID qw(cgisuidsetup);
  58 use FS::Record qw(qsearch qsearchs);
  59 use FS::CGI qw(header popurl);
  60 use FS::part_pkg;
  61 use FS::type_pkgs;
  62
  63 $cgi = new CGI;
  64 &cgisuidsetup($cgi);
  65
  66 %pkg = ();
  67 %comment = ();
  68 foreach (qsearch('part_pkg', {})) {
  69   $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
  70   $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
  71 }
  72
  73 if ( $cgi->param('error') ) {
  74   $custnum = $cgi->param('custnum');
  75   %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg');
  76 } else {
  77   my($query) = $cgi->keywords;
  78   $query =~ /^(\d+)$/;
  79   $custnum = $1;
  80   undef %remove_pkg;
  81 }
  82
  83 $p1 = popurl(1);
  84 print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", '');
  85
  86 print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
  87       "</FONT>"
  88   if $cgi->param('error');
  89
  90 print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!;
  91
  92 print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
  93
  94 #current packages
  95 @cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } );
  96
  97 if (@cust_pkg) {
  98   print <<END;
  99 Current packages - select to remove (services are moved to a new package below)
 100 <BR><BR>
 101 END
 102
 103   my ($count) = 0 ;
 104   print qq!<TABLE>! ;
 105   foreach (@cust_pkg) {
 106     print '<TR>' if $count == 0;
 107     my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
 108     print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!;
 109     print " CHECKED" if $remove_pkg{$pkgnum};
 110     print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
 111     $count ++ ;
 112     if ($count == 2)
 113     {
 114       $count = 0 ;
 115       print qq!</TR>\n! ;
 116     }
 117   }
 118   print qq!</TABLE><BR><BR>!;
 119 }
 120
 121 print <<END;
 122 Order new packages<BR><BR>
 123 END
 124
 125 $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
 126 $agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
 127
 128 $count = 0;
 129 $pkgparts = 0;
 130 print qq!<TABLE>!;
 131 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
 132   $pkgparts++;
 133   my($pkgpart)=$type_pkgs->pkgpart;
 134   print qq!<TR>! if ( $count == 0 );
 135   my $value = $cgi->param("pkg$pkgpart") || 0;
 136   print <<END;
 137   <TD>
 138   <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2">
 139   $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
 140 END
 141   $count ++ ;
 142   if ( $count == 2 ) {
 143     print qq!</TR>\n! ;
 144     $count = 0;
 145   }
 146 }
 147 print qq!</TABLE>!;
 148
 149 unless ( $pkgparts ) {
 150   my $p2 = popurl(2);
 151   my $typenum = $agent->typenum;
 152   my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
 153   my $atype = $agent_type->atype;
 154   print <<END;
 155 (No <a href="${p2}browse/part_pkg.cgi">package definitions</a>, or agent type
 156 <a href="${p2}edit/agent_type.cgi?$typenum">$atype</a> not allowed to purchase
 157 any packages.)
 158 END
 159 }
 160
 161 #submit
 162 print <<END;
 163 <P><INPUT TYPE="submit" VALUE="Order">
 164     </FORM>
 165   </BODY>
 166 </HTML>
 167 END