htdocs/view/svc_acct_sm.cgi

   1 #!/usr/bin/perl -Tw
   2 #
   3 # $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:04:03 ivan Exp $
   4 #
   5 # Usage: svc_acct_sm.cgi svcnum
   6 #        http://server.name/path/svc_acct_sm.cgi?svcnum
   7 #
   8 # based on view/svc_acct.cgi
   9 #
  10 # ivan@voicenet.com 97-jan-5
  11 #
  12 # added navigation bar
  13 # ivan@voicenet.com 97-jan-30
  14 #
  15 # rewrite ivan@sisd.com 98-mar-15
  16 #
  17 # Changes to allow page to work at a relative position in server
  18 #       bmccane@maxbaud.net     98-apr-3
  19 #
  20 # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
  21 #
  22 # $Log: svc_acct_sm.cgi,v $
  23 # Revision 1.9  1999-02-28 00:04:03  ivan
  24 # removed misleading comments
  25 #
  26 # Revision 1.8  1999/02/09 09:23:00  ivan
  27 # visual and bugfixes
  28 #
  29 # Revision 1.7  1999/02/07 09:59:42  ivan
  30 # more mod_perl fixes, and bugfixes Peter Wemm sent via email
  31 #
  32 # Revision 1.6  1999/01/19 05:14:22  ivan
  33 # for mod_perl: no more top-level my() variables; use vars instead
  34 # also the last s/create/new/;
  35 #
  36 # Revision 1.5  1999/01/18 09:41:46  ivan
  37 # all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
  38 # (good idea anyway)
  39 #
  40 # Revision 1.4  1998/12/23 03:09:52  ivan
  41 # $cgi->keywords instead of $cgi->query_string
  42 #
  43 # Revision 1.3  1998/12/17 09:57:24  ivan
  44 # s/CGI::(Base|Request)/CGI.pm/;
  45 #
  46 # Revision 1.2  1998/12/16 05:24:30  ivan
  47 # use FS::Conf;
  48 #
  49
  50 use strict;
  51 use vars qw($conf $cgi $mydomain $query $svcnum $svc_acct_sm $cust_svc
  52             $pkgnum $cust_pkg $custnum $part_svc $p $domsvc $domuid $domuser
  53             $svc $svc_domain $domain $svc_acct $username );
  54 use CGI;
  55 use FS::UID qw(cgisuidsetup);
  56 use FS::CGI qw(header popurl);
  57 use FS::Record qw(qsearchs);
  58 use FS::Conf;
  59 use FS::svc_acct_sm;
  60 use FS::cust_svc;
  61 use FS::cust_pkg;
  62 use FS::part_svc;
  63 use FS::svc_domain;
  64 use FS::svc_acct;
  65
  66 $cgi = new CGI;
  67 cgisuidsetup($cgi);
  68
  69 $conf = new FS::Conf;
  70 $mydomain = $conf->config('domain');
  71
  72 #untaint svcnum
  73 ($query) = $cgi->keywords;
  74 $query =~ /^(\d+)$/;
  75 $svcnum = $1;
  76 $svc_acct_sm = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
  77 die "Unknown svcnum" unless $svc_acct_sm;
  78
  79 $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
  80 $pkgnum = $cust_svc->getfield('pkgnum');
  81 if ($pkgnum) {
  82   $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
  83   $custnum=$cust_pkg->getfield('custnum');
  84 } else {
  85   $cust_pkg = '';
  86   $custnum = '';
  87 }
  88
  89 $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
  90 die "Unkonwn svcpart" unless $part_svc;
  91
  92 print $cgi->header( '-expires' => 'now' ), header('Mail Alias View');
  93
  94 $p = popurl(2);
  95 if ($pkgnum || $custnum) {
  96   print <<END;
  97 <A HREF="${p}view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
  98 <A HREF="${p}view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
  99 END
 100 } else {
 101   print <<END;
 102 <A HREF="${p}misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
 103 END
 104 }
 105
 106 print <<END;
 107     <A HREF="${p}">Main menu</A></CENTER><BR>
 108     Service #$svcnum
 109     <P><A HREF="${p}edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>
 110 END
 111
 112 ($domsvc,$domuid,$domuser) = (
 113   $svc_acct_sm->domsvc,
 114   $svc_acct_sm->domuid,
 115   $svc_acct_sm->domuser,
 116 );
 117 $svc = $part_svc->svc;
 118 $svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc});
 119 $domain = $svc_domain->domain;
 120 $svc_acct = qsearchs('svc_acct',{'uid'=>$domuid});
 121 $username = $svc_acct->username;
 122
 123 #formatting
 124 print qq!<BR><BR>!;
 125
 126 #svc
 127 print "Service: <B>$svc</B>";
 128
 129 print "<BR><BR>";
 130
 131 print qq!Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!;
 132
 133         #formatting
 134         print <<END;
 135
 136   </BODY>
 137 </HTML>
 138 END
 139