summaryrefslogtreecommitdiff
path: root/htdocs/misc
diff options
context:
space:
mode:
Diffstat (limited to 'htdocs/misc')
-rwxr-xr-xhtdocs/misc/bill.cgi66
-rwxr-xr-xhtdocs/misc/cancel-unaudited.cgi90
-rwxr-xr-xhtdocs/misc/cancel_pkg.cgi45
-rwxr-xr-xhtdocs/misc/delete-customer.cgi58
-rwxr-xr-xhtdocs/misc/expire_pkg.cgi66
-rwxr-xr-xhtdocs/misc/link.cgi63
-rwxr-xr-xhtdocs/misc/print-invoice.cgi66
-rwxr-xr-xhtdocs/misc/process/delete-customer.cgi46
-rwxr-xr-xhtdocs/misc/process/link.cgi71
-rwxr-xr-xhtdocs/misc/susp_pkg.cgi64
-rwxr-xr-xhtdocs/misc/unsusp_pkg.cgi61
11 files changed, 403 insertions, 293 deletions
diff --git a/htdocs/misc/bill.cgi b/htdocs/misc/bill.cgi
index d41f6d1c9..52323ba59 100755
--- a/htdocs/misc/bill.cgi
+++ b/htdocs/misc/bill.cgi
@@ -1,36 +1,50 @@
#!/usr/bin/perl -Tw
#
+# $Id: bill.cgi,v 1.5 1999-08-12 04:32:21 ivan Exp $
+#
# s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: bill.cgi,v $
+# Revision 1.5 1999-08-12 04:32:21 ivan
+# hidecancelledcustomers
+#
+# Revision 1.4 1999/01/19 05:14:02 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:01:13 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:41 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw( $cgi $query $custnum $cust_main $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
-use FS::Bill;
+use FS::cust_main;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint custnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+$custnum = $1;
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
die "Can't find customer!\n" unless $cust_main;
-# ?
-bless($cust_main,"FS::Bill");
-
-my($error);
-
$error = $cust_main->bill(
# 'time'=>$time
);
-&idiot($error) if $error;
+&eidiot($error) if $error;
$error = $cust_main->collect(
# 'invoice-time'=>$time,
@@ -38,29 +52,7 @@ $error = $cust_main->collect(
'batch_card'=> 'no',
'report_badcard'=> 'yes',
);
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error billing customer</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error billing customer</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
- exit;
+&eidiot($error) if $error;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum");
diff --git a/htdocs/misc/cancel-unaudited.cgi b/htdocs/misc/cancel-unaudited.cgi
index 929274f38..319ac5526 100755
--- a/htdocs/misc/cancel-unaudited.cgi
+++ b/htdocs/misc/cancel-unaudited.cgi
@@ -1,12 +1,10 @@
#!/usr/bin/perl -Tw
#
-# cancel-unaudited.cgi: Cancel an unaudited account
+# $Id: cancel-unaudited.cgi,v 1.8 2001-04-09 23:05:16 ivan Exp $
#
# Usage: cancel-unaudited.cgi svcnum
# http://server.name/path/cancel-unaudited.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# ivan@voicenet.com 97-apr-23
#
# rewrote for new API
@@ -16,31 +14,57 @@
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cancel-unaudited.cgi,v $
+# Revision 1.8 2001-04-09 23:05:16 ivan
+# Transactions Part I!!!
+#
+# Revision 1.7 2000/06/15 12:30:37 ivan
+# bugfix from Jeff Finucane, thanks!
+#
+# Revision 1.6 1999/02/28 00:03:48 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:34 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:03 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:02:05 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:42 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error $dbh );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
use FS::cust_svc;
use FS::svc_acct;
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
+$cgi = new CGI;
+$dbh = &cgisuidsetup($cgi);
#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
-my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum});
-&idiot("Unknown svcnum!") unless $svc_acct;
+$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+die "Unknown svcnum!" unless $svc_acct;
-my($cust_svc) = qsearchs('cust_svc',{'svcnum'=>$svcnum});
-&idiot(qq!This account has already been audited. Cancel the
- <A HREF="../view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+&eidiot(qq!This account has already been audited. Cancel the
+ <A HREF="!. popurl(2). qq!view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
qq!pkgnum"> package</A> instead.!)
- if $cust_svc->getfield('pkgnum') ne '';
+ if $cust_svc->pkgnum ne '' && $cust_svc->pkgnum ne '0';
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -48,38 +72,22 @@ local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
-my($error);
+local $FS::UID::AutoCommit = 0;
-bless($svc_acct,"FS::svc_acct");
$error = $svc_acct->cancel;
-&idiot($error) if $error;
+&myeidiot($error) if $error;
$error = $svc_acct->delete;
-&idiot($error) if $error;
+&myeidiot($error) if $error;
-bless($cust_svc,"FS::cust_svc");
$error = $cust_svc->delete;
-&idiot($error) if $error;
+&myeidiot($error) if $error;
+
+$dbh->commit or die $dbh->errstr;
-$cgi->redirect("../");
+print $cgi->redirect(popurl(2));
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error cancelling account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error cancelling account</H1>
- </CENTER>
- <HR>
- There has been an error cancelling this acocunt: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
+sub myeidiot {
+ $dbh->rollback;
+ &eidiot(@_);
}
diff --git a/htdocs/misc/cancel_pkg.cgi b/htdocs/misc/cancel_pkg.cgi
index 6702a0351..7bbcf6e7f 100755
--- a/htdocs/misc/cancel_pkg.cgi
+++ b/htdocs/misc/cancel_pkg.cgi
@@ -1,12 +1,10 @@
#!/usr/bin/perl -Tw
#
-# cancel_pkg.cgi: Cancel a package
+# $Id: cancel_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
#
# Usage: cancel_pkg.cgi pkgnum
# http://server.name/path/cancel_pkg.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!!
#
# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
@@ -27,28 +25,47 @@
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cancel_pkg.cgi,v $
+# Revision 1.6 1999-04-08 10:35:02 ivan
+# import necessary subroutines from FS::CGI
+#
+# Revision 1.5 1999/02/28 00:03:49 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:04 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:02:54 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:43 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw ( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(eidiot popurl);
use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl eidiot);
use FS::cust_pkg;
-use FS::CGI qw(idiot);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->cancel;
-idiot($error) if $error;
+$error = $cust_pkg->cancel;
+eidiot($error) if $error;
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
diff --git a/htdocs/misc/delete-customer.cgi b/htdocs/misc/delete-customer.cgi
new file mode 100755
index 000000000..8addbd657
--- /dev/null
+++ b/htdocs/misc/delete-customer.cgi
@@ -0,0 +1,58 @@
+#!/usr/bin/perl -Tw
+#
+# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $
+#
+# $Log: delete-customer.cgi,v $
+# Revision 1.1 1999-04-15 16:44:36 ivan
+# delete customers
+#
+
+use strict;
+use vars qw( $cgi $conf $query $custnum $new_custnum $cust_main );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+if ( $cgi->param('error') ) {
+ $custnum = $cgi->param('custnum');
+ $new_custnum = $cgi->param('new_custnum');
+} else {
+ ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/ or die "Illegal query: $query";
+ $custnum = $1;
+ $new_custnum = '';
+}
+$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+ or die "Customer not found: $custnum";
+
+print $cgi->header ( '-expires' => 'now' ), header('Delete customer');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print
+ qq!<form action="!, popurl(1), qq!process/delete-customer.cgi" method=post>!,
+ qq!<input type="hidden" name="custnum" value="$custnum">!;
+
+if ( qsearch('cust_pkg', { 'custnum' => $custnum, 'cancel' => '' } ) ) {
+ print "Move uncancelled packages to customer number ",
+ qq!<input type="text" name="new_custnum" value="$new_custnum"><br><br>!;
+}
+
+print <<END;
+This will <b>completely remove</b> all traces of this customer record.
+<br>Are you <b>absolutely sure</b> you want to delete this customer?
+<br><input type="submit" value="Yes">
+</form></body></html>
+END
+
diff --git a/htdocs/misc/expire_pkg.cgi b/htdocs/misc/expire_pkg.cgi
index 163516627..cf1f23153 100755
--- a/htdocs/misc/expire_pkg.cgi
+++ b/htdocs/misc/expire_pkg.cgi
@@ -1,12 +1,10 @@
#!/usr/bin/perl -Tw
#
-# expire_pkg.cgi: Expire a package
+# $Id: expire_pkg.cgi,v 1.4 1999-02-28 00:03:50 ivan Exp $
#
# Usage: post form to:
# http://server.name/path/expire_pkg.cgi
#
-# Note: Should be run setuid freeside as user nobody
-#
# based on susp_pkg
# ivan@voicenet.com 97-jul-29
#
@@ -14,58 +12,50 @@
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: expire_pkg.cgi,v $
+# Revision 1.4 1999-02-28 00:03:50 ivan
+# removed misleading comments
+#
+# Revision 1.3 1999/01/19 05:14:05 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:12:44 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
+use vars qw ( $cgi $date $pkgnum $cust_pkg %hash $new $error );
use Date::Parse;
-use CGI::Request;
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
use FS::cust_pkg;
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
+$cgi = new CGI;
+&cgisuidsetup($cgi);
#untaint date & pkgnum
-my($date);
-if ( $req->param('date') ) {
- str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date";
+if ( $cgi->param('date') ) {
+ str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date";
$date=$1;
} else {
$date='';
}
-$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
-my($pkgnum)=$1;
+$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
+$pkgnum = $1;
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my(%hash)=$cust_pkg->hash;
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+%hash = $cust_pkg->hash;
$hash{expire}=$date;
-my($new)=create FS::cust_pkg ( \%hash );
-my($error) = $new->replace($cust_pkg);
-&idiot($error) if $error;
-
-$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+$new = new FS::cust_pkg ( \%hash );
+$error = $new->replace($cust_pkg);
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error expiring package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error expiring package</H1>
- </CENTER>
- <HR>
- There has been an error expiring this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
diff --git a/htdocs/misc/link.cgi b/htdocs/misc/link.cgi
index d1db000ec..eb1780711 100755
--- a/htdocs/misc/link.cgi
+++ b/htdocs/misc/link.cgi
@@ -1,21 +1,45 @@
#!/usr/bin/perl -Tw
#
-# link: instead of adding a new account, link to an existing. (output form)
-#
-# Note: Should be run setuid freeside as user nobody
+# $Id: link.cgi,v 1.7 1999-04-08 11:31:40 ivan Exp $
#
# ivan@voicenet.com 97-feb-5
#
# rewrite ivan@sisd.com 98-mar-17
#
# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
+#
+# $Log: link.cgi,v $
+# Revision 1.7 1999-04-08 11:31:40 ivan
+# *** empty log message ***
+#
+# Revision 1.6 1999/02/28 00:03:51 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/19 05:14:06 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:36 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/23 03:03:39 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:45 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw ( %link_field $cgi $pkgnum $svcpart $query $part_svc $svc $svcdb
+ $link_field );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl header);
use FS::Record qw(qsearchs);
-my(%link_field)=(
+%link_field = (
'svc_acct' => 'username',
'svc_domain' => 'domain',
'svc_acct_sm' => '',
@@ -23,33 +47,22 @@ my(%link_field)=(
'svc_wo' => '',
);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-my($pkgnum,$svcpart);
-foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart
+($query) = $cgi->keywords;
+foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
$pkgnum=$1 if /^pkgnum(\d+)$/;
$svcpart=$1 if /^svcpart(\d+)$/;
}
-my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
-my($svc) = $part_svc->getfield('svc');
-my($svcdb) = $part_svc->getfield('svcdb');
-my($link_field) = $link_field{$svcdb};
+$part_svc = qsearchs('part_svc',{'svcpart'=>$svcpart});
+$svc = $part_svc->getfield('svc');
+$svcdb = $part_svc->getfield('svcdb');
+$link_field = $link_field{$svcdb};
-CGI::Base::SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Link to existing $svc account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Link to existing $svc account</H1>
- </CENTER><HR>
- <FORM ACTION="process/link.cgi" METHOD=POST>
-END
+print $cgi->header( '-expires' => 'now' ), header("Link to existing $svc"),
+ qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!;
if ( $link_field ) {
print <<END;
diff --git a/htdocs/misc/print-invoice.cgi b/htdocs/misc/print-invoice.cgi
index 084dcc1c4..213f15406 100755
--- a/htdocs/misc/print-invoice.cgi
+++ b/htdocs/misc/print-invoice.cgi
@@ -1,57 +1,51 @@
#!/usr/bin/perl -Tw
#
+# $Id: print-invoice.cgi,v 1.4 1999-01-19 05:14:07 ivan Exp $
+#
# just a kludge for now, since this duplicates in a way it shouldn't stuff from
# Bill.pm (like $lpr) ivan@sisd.com 98-jun-16
+#
+# $Log: print-invoice.cgi,v $
+# Revision 1.4 1999-01-19 05:14:07 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:04:24 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:47 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI);
+use vars qw($conf $cgi $lpr $query $invnum $cust_bill $custnum );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
use FS::Record qw(qsearchs);
-use FS::Invoice;
-
-my($lpr) = "|lpr -h";
+use FS::cust_bill;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
+$conf = new FS::Conf;
+$lpr = $conf->config('lpr');
+
#untaint invnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($invnum)=$1;
-my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+$invnum = $1;
+$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
die "Can't find invoice!\n" unless $cust_bill;
- bless($cust_bill,"FS::Invoice");
- open(LPR,$lpr) or die "Can't open $lpr: $!";
+ open(LPR,"|$lpr") or die "Can't open $lpr: $!";
print LPR $cust_bill->print_text; #( date )
close LPR
or die $! ? "Error closing $lpr: $!"
: "Exit status $? from $lpr";
-my($custnum)=$cust_bill->getfield('custnum');
-
-$cgi->redirect("../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error printing invoice</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error printing invoice</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
- exit;
-
-}
+$custnum = $cust_bill->getfield('custnum');
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
diff --git a/htdocs/misc/process/delete-customer.cgi b/htdocs/misc/process/delete-customer.cgi
new file mode 100755
index 000000000..0a939c559
--- /dev/null
+++ b/htdocs/misc/process/delete-customer.cgi
@@ -0,0 +1,46 @@
+#!/usr/bin/perl -Tw
+#
+# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $
+#
+# $Log: delete-customer.cgi,v $
+# Revision 1.1 1999-04-15 16:44:36 ivan
+# delete customers
+#
+
+use strict;
+use vars qw ( $cgi $conf $custnum $new_custnum $cust_main $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+$cgi->param('custnum') =~ /^(\d+)$/;
+$custnum = $1;
+if ( $cgi->param('new_custnum') ) {
+ $cgi->param('new_custnum') =~ /^(\d+)$/
+ or die "Illegal new customer number: ". $cgi->param('new_custnum');
+ $new_custnum = $1;
+} else {
+ $new_custnum = '';
+}
+$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+ or die "Customer not found: $custnum";
+
+$error = $cust_main->delete($new_custnum);
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "delete-customer.cgi?". $cgi->query_string );
+} elsif ( $new_custnum ) {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$new_custnum");
+} else {
+ print $cgi->redirect(popurl(3));
+}
diff --git a/htdocs/misc/process/link.cgi b/htdocs/misc/process/link.cgi
index 23fb05386..7d6bd506f 100755
--- a/htdocs/misc/process/link.cgi
+++ b/htdocs/misc/process/link.cgi
@@ -1,6 +1,6 @@
#!/usr/bin/perl -Tw
#
-# process/link.cgi: link to existing customer (process form)
+# $Id: link.cgi,v 1.6 2000-07-17 17:59:33 ivan Exp $
#
# ivan@voicenet.com 97-feb-5
#
@@ -10,64 +10,67 @@
# bmccane@maxbaud.net 98-apr-3
#
# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
+#
+# $Log: link.cgi,v $
+# Revision 1.6 2000-07-17 17:59:33 ivan
+# oops
+#
+# Revision 1.5 1999/04/15 14:09:17 ivan
+# get rid of top-level my() variables
+#
+# Revision 1.4 1999/02/07 09:59:35 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.3 1999/01/19 05:14:10 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:15:00 ivan
+# s/CGI::Request/CGI.pm/;
+#
use strict;
-use CGI::Request;
+use vars qw ( $cgi $old $new $error $pkgnum $svcpart $svcnum );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
-use FS::CGI qw(idiot);
+use FS::CGI qw(popurl idiot eidiot);
use FS::UID qw(cgisuidsetup);
use FS::cust_svc;
use FS::Record qw(qsearchs);
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-#$req->import_names('R'); #import CGI variables into package 'R';
+$cgi = new CGI;
+cgisuidsetup($cgi);
-$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
-$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
+$cgi->param('pkgnum') =~ /^(\d+)$/;
+$pkgnum = $1;
+$cgi->param('svcpart') =~ /^(\d+)$/;
+$svcpart = $1;
+$cgi->param('svcnum') =~ /^(\d*)$/;
+$svcnum = $1;
-$req->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1;
unless ( $svcnum ) {
my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
my($svcdb) = $part_svc->getfield('svcdb');
- $req->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
- my($svc_acct)=qsearchs($svcdb,{$link_field => $req->param('link_value') });
- idiot("$link_field not found!") unless $svc_acct;
+ $cgi->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
+ my($svc_acct)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') });
+ eidiot("$link_field not found!") unless $svc_acct;
$svcnum=$svc_acct->svcnum;
}
-my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$old = qsearchs('cust_svc',{'svcnum'=>$svcnum});
die "svcnum not found!" unless $old;
-my($new)=create FS::cust_svc ({
+$new = new FS::cust_svc ({
'svcnum' => $svcnum,
'pkgnum' => $pkgnum,
'svcpart' => $svcpart,
});
-my($error);
$error = $new->replace($old);
unless ($error) {
#no errors, so let's view this customer.
- $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum");
+ print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum");
} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
+ idiot($error);
}
diff --git a/htdocs/misc/susp_pkg.cgi b/htdocs/misc/susp_pkg.cgi
index 7b23caeb2..abe4f70b0 100755
--- a/htdocs/misc/susp_pkg.cgi
+++ b/htdocs/misc/susp_pkg.cgi
@@ -1,12 +1,10 @@
#!/usr/bin/perl -Tw
#
-# susp_pkg.cgi: Suspend a package
+# $Id: susp_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
#
# Usage: susp_pkg.cgi pkgnum
# http://server.name/path/susp_pkg.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
#
# ivan@voicenet.com 97-feb-27
@@ -21,48 +19,46 @@
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: susp_pkg.cgi,v $
+# Revision 1.6 1999-04-08 10:35:02 ivan
+# import necessary subroutines from FS::CGI
+#
+# Revision 1.5 1999/02/28 00:03:52 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:08 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:04:56 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:48 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl eidiot);
use FS::cust_pkg;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->suspend;
-&idiot($error) if $error;
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+$error = $cust_pkg->suspend;
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error suspending package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error suspending package</H1>
- </CENTER>
- <HR>
- There has been an error suspending this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
diff --git a/htdocs/misc/unsusp_pkg.cgi b/htdocs/misc/unsusp_pkg.cgi
index 2f340c6fa..9e60064c3 100755
--- a/htdocs/misc/unsusp_pkg.cgi
+++ b/htdocs/misc/unsusp_pkg.cgi
@@ -1,12 +1,10 @@
#!/usr/bin/perl -Tw
#
-# susp_pkg.cgi: Unsuspend a package
+# $Id: unsusp_pkg.cgi,v 1.5 1999-02-28 00:03:53 ivan Exp $
#
# Usage: susp_pkg.cgi pkgnum
# http://server.name/path/susp_pkg.cgi pkgnum
#
-# Note: Should be run setuid freeside as user nobody
-#
# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
#
# ivan@voicenet.com 97-feb-27
@@ -21,48 +19,43 @@
#
# Changes to allow page to work at a relative position in server
# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: unsusp_pkg.cgi,v $
+# Revision 1.5 1999-02-28 00:03:53 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:09 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:05:25 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:49 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
+use vars qw( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
use FS::Record qw(qsearchs);
use FS::cust_pkg;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
&cgisuidsetup($cgi);
#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->unsuspend;
-&idiot($error) if $error;
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+$error = $cust_pkg->unsuspend;
+&eidiot($error) if $error;
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error unsuspending package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error unsuspending package</H1>
- </CENTER>
- <HR>
- There has been an error unsuspending this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 21:35:49 +0000