all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
[freeside.git] / htdocs / misc / cancel_pkg.cgi
1 #!/usr/bin/perl -Tw
2 #
3 # $Id: cancel_pkg.cgi,v 1.3 1998-12-23 03:02:54 ivan Exp $
4 #
5 # Usage: cancel_pkg.cgi pkgnum
6 #        http://server.name/path/cancel_pkg.cgi pkgnum
7 #
8 # Note: Should be run setuid freeside as user nobody
9 #
10 # IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!!
11 #
12 # probably should generalize this to do cancels, suspensions, unsuspensions, etc.
13 #
14 # ivan@voicenet.com 97-jan-2
15 #
16 # still kludgy, but now runs /dbin/cancel $pkgnum
17 # ivan@voicenet.com 97-feb-27
18 #
19 # doesn't run if pkgnum doesn't match regex
20 # ivan@voicenet.com 97-mar-6
21 #
22 # now redirects to enter comments
23 # ivan@voicenet.com 97-may-8
24 #
25 # rewrote for new API
26 # ivan@voicenet.com 97-jul-21
27 #
28 # Changes to allow page to work at a relative position in server
29 #       bmccane@maxbaud.net     98-apr-3
30 #
31 # $Log: cancel_pkg.cgi,v $
32 # Revision 1.3  1998-12-23 03:02:54  ivan
33 # $cgi->keywords instead of $cgi->query_string
34 #
35 # Revision 1.2  1998/12/17 09:12:43  ivan
36 # s/CGI::(Request|Base)/CGI.pm/;
37 #
38
39 use strict;
40 use CGI;
41 use CGI::Carp qw(fatalsToBrowser);
42 use FS::UID qw(cgisuidsetup);
43 use FS::CGI qw(eidiot popurl);
44 use FS::Record qw(qsearchs);
45 use FS::cust_pkg;
46
47 my($cgi) = new CGI;
48 &cgisuidsetup($cgi);
49  
50 #untaint pkgnum
51 my($query) = $cgi->keywords;
52 $query =~ /^(\d+)$/ || die "Illegal pkgnum";
53 my($pkgnum)=$1;
54
55 my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
56
57 my($error)=$cust_pkg->cancel;
58 eidiot($error) if $error;
59
60 print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
61