all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
[freeside.git] / htdocs / search / svc_acct_sm.cgi
1 #!/usr/bin/perl -Tw
2 #
3 # $Id: svc_acct_sm.cgi,v 1.4 1999-01-18 09:41:40 ivan Exp $
4 #
5 # Usage: post form to:
6 #        http://server.name/path/svc_domain.cgi
7 #
8 # Note: Should be run setuid freeside as user nobody.
9 #
10 # ivan@voicenet.com 96-mar-5
11 #
12 # need to look at table in results to make it more readable
13 #
14 # ivan@voicenet.com
15 #
16 # rewrite ivan@sisd.com 98-mar-15
17 #
18 # Changes to allow page to work at a relative position in server
19 #       bmccane@maxbaud.net     98-apr-3
20 #
21 # $Log: svc_acct_sm.cgi,v $
22 # Revision 1.4  1999-01-18 09:41:40  ivan
23 # all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
24 # (good idea anyway)
25 #
26 # Revision 1.3  1998/12/17 09:41:11  ivan
27 # s/CGI::(Base|Request)/CGI.pm/;
28 #
29
30 use strict;
31 use vars qw($conf);
32 use CGI::Request;
33 use CGI::Carp qw(fatalsToBrowser);
34 use FS::UID qw(cgisuidsetup);
35 use FS::CGI qw(popurl idiot header table);
36 use FS::Record qw(qsearch qsearchs);
37 use FS::Conf;
38
39 my($cgi)=new CGI;
40 &cgisuidsetup($cgi);
41
42 $conf = new FS::Conf;
43 my $mydomain = $conf->config('domain');
44
45 $cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
46 my($domuser)=$1;
47
48 $cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
49 my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1})
50   or die "Unknown domain";
51 my($domsvc)=$svc_domain->svcnum;
52
53 my(@svc_acct_sm);
54 if ($domuser) {
55   @svc_acct_sm=qsearch('svc_acct_sm',{
56     'domuser' => $domuser,
57     'domsvc'  => $domsvc,
58   });
59 } else {
60   @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
61 }
62
63 if ( scalar(@svc_acct_sm) == 1 ) {
64   my($svcnum)=$svc_acct_sm[0]->svcnum;
65   print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum");  #redirect
66 } elsif ( scalar(@svc_acct_sm) > 1 ) {
67   CGI::Base::SendHeaders();
68   print $cgi->header( '-expires' => 'now' ), header('Mail Alias Search Results'), table, <<END;
69       <TR>
70         <TH>Mail to<BR><FONT SIZE=-2>(click here to view mail alias)</FONT></TH>
71         <TH>Forwards to<BR><FONT SIZE=-2>(click here to view account)</FONT></TH>
72       </TR>
73 END
74
75   my($svc_acct_sm);
76   foreach $svc_acct_sm (@svc_acct_sm) {
77     my($svcnum,$domuser,$domuid,$domsvc)=(
78       $svc_acct_sm->svcnum,
79       $svc_acct_sm->domuser,
80       $svc_acct_sm->domuid,
81       $svc_acct_sm->domsvc,
82     );
83     my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
84     my($domain)=$svc_domain->domain;
85     my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
86     my($username)=$svc_acct->username;
87     my($svc_acct_svcnum)=$svc_acct->svcnum;
88
89     print qq!<TR>\n        <TD> <A HREF="!. popurl(2). qq!view/svc_acct_sm.cgi?$svcnum">!;
90
91     print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
92
93     print <<END;
94 \@$domain</A> </TD>\n
95 <TD> <A HREF="../view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A> </TD>\n      </TR>\n
96 END
97
98   }
99
100   print <<END;
101       </TABLE>
102     </CENTER>
103   </BODY>
104 </HTML>
105 END
106
107 } else { #error
108   idiot("Mail Alias not found");
109 }
110