diff options
Diffstat (limited to 'htdocs/edit/process')
| -rwxr-xr-x | htdocs/edit/process/cust_pkg.cgi | 25 | ||||
| -rwxr-xr-x | htdocs/edit/process/part_pkg.cgi | 72 | ||||
| -rwxr-xr-x | htdocs/edit/process/part_referral.cgi | 30 | ||||
| -rwxr-xr-x | htdocs/edit/process/part_svc.cgi | 24 | ||||
| -rwxr-xr-x | htdocs/edit/process/svc_acct.cgi | 28 | ||||
| -rwxr-xr-x | htdocs/edit/process/svc_acct_pop.cgi | 25 | ||||
| -rwxr-xr-x | htdocs/edit/process/svc_acct_sm.cgi | 21 | ||||
| -rwxr-xr-x | htdocs/edit/process/svc_domain.cgi | 17 |
8 files changed, 147 insertions, 95 deletions
diff --git a/htdocs/edit/process/cust_pkg.cgi b/htdocs/edit/process/cust_pkg.cgi index 639b2f140..2c5eaef97 100755 --- a/htdocs/edit/process/cust_pkg.cgi +++ b/htdocs/edit/process/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cust_pkg.cgi,v 1.4 1999-01-25 12:19:10 ivan Exp $ +# $Id: cust_pkg.cgi,v 1.5 1999-02-07 09:59:26 ivan Exp $ # # this is for changing packages around, not for editing things within the # package @@ -21,8 +21,8 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: cust_pkg.cgi,v $ -# Revision 1.4 1999-01-25 12:19:10 ivan -# yet more mod_perl stuff +# Revision 1.5 1999-02-07 09:59:26 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email # # Revision 1.3 1999/01/19 05:13:54 ivan # for mod_perl: no more top-level my() variables; use vars instead @@ -37,15 +37,15 @@ use vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(idiot popurl); +use FS::CGI qw(popurl); use FS::cust_pkg; $cgi = new CGI; # create form object - &cgisuidsetup($cgi); +$error = ''; #untaint custnum -$cgi->param('new_custnum') =~ /^(\d+)$/; +$cgi->param('custnum') =~ /^(\d+)$/; $custnum = $1; @remove_pkgnums = map { @@ -54,13 +54,18 @@ $custnum = $1; } $cgi->param('remove_pkg'); foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) { - my($num_pkgs)=$cgi->param("pkg$pkgpart"); - while ( $num_pkgs-- ) { - push @pkgparts,$pkgpart; + if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) { + my $num_pkgs = $1; + while ( $num_pkgs-- ) { + push @pkgparts,$pkgpart; + } + } else { + $error = "Illegal quantity"; + last; } } -$error = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); +$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); if ($error) { $cgi->param('error', $error); diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index 3ec31589a..adf4672bd 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_pkg.cgi,v 1.7 1999-01-19 05:13:55 ivan Exp $ +# $Id: part_pkg.cgi,v 1.8 1999-02-07 09:59:27 ivan Exp $ # # process/part_pkg.cgi: Edit package definitions (process form) # @@ -17,7 +17,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_pkg.cgi,v $ -# Revision 1.7 1999-01-19 05:13:55 ivan +# Revision 1.8 1999-02-07 09:59:27 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:55 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -38,11 +41,11 @@ # use strict; -use vars qw( $cgi $pkgpart $old $new $part_svc ); +use vars qw( $cgi $pkgpart $old $new $part_svc $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(eidiot popurl); +use FS::CGI qw(popurl); use FS::Record qw(qsearch qsearchs fields); use FS::part_pkg; use FS::pkg_svc; @@ -61,44 +64,55 @@ $new = new FS::part_pkg ( { } fields('part_pkg') } ); +#most of the stuff below should move to part_pkg.pm + +foreach $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + unless ( $quantity =~ /^(\d+)$/ ) { + $cgi->param('error', "Illegal quantity" ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; + } +} + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; +local $SIG{PIPE} = 'IGNORE'; if ( $pkgpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; - $pkgpart=$new->getfield('pkgpart'); + $error = $new->insert; + $pkgpart=$new->pkgpart; +} +if ( $error ) { + $cgi->param('error', $error ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; } foreach $part_svc (qsearch('part_svc',{})) { -# don't update non-changing records in part_svc (causing harmless but annoying -# "Records identical" errors). ivan@sisd.com 98-jan-19 - #my($quantity)=$cgi->param('pkg_svc'. $part_svc->getfield('svcpart')), - my($quantity)=$cgi->param('pkg_svc'. $part_svc->svcpart) || 0, - my($old_pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - }); - my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; next unless $old_quantity != $quantity; #!here - my($new_pkg_svc)=new FS::pkg_svc({ + my $new_pkg_svc = new FS::pkg_svc( { 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - #'quantity' => $cgi->param('pkg_svc'. $part_svc->getfield('svcpart')), + 'svcpart' => $part_svc->svcpart, 'quantity' => $quantity, - }); - if ($old_pkg_svc) { - my($error)=$new_pkg_svc->replace($old_pkg_svc); - eidiot($error) if $error; + } ); + if ( $old_pkg_svc ) { + my $myerror = $new_pkg_svc->replace($old_pkg_svc); + die $myerror if $myerror; } else { - my($error)=$new_pkg_svc->insert; - eidiot($error) if $error; + my $myerror = $new_pkg_svc->insert; + die $myerror if $myerror; } } @@ -109,8 +123,8 @@ unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { my %hash = $old_cust_pkg->hash; $hash{'pkgpart'} = $pkgpart; my($new_cust_pkg) = new FS::cust_pkg \%hash; - my $error = $new_cust_pkg->replace($old_cust_pkg); - eidiot "Error modifying cust_pkg record: $error\n" if $error; + my $myerror = $new_cust_pkg->replace($old_cust_pkg); + die "Error modifying cust_pkg record: $myerror\n" if $myerror; print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum); } diff --git a/htdocs/edit/process/part_referral.cgi b/htdocs/edit/process/part_referral.cgi index 9886015f9..cde27ede1 100755 --- a/htdocs/edit/process/part_referral.cgi +++ b/htdocs/edit/process/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_referral.cgi,v 1.5 1999-01-19 05:13:56 ivan Exp $ +# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_referral.cgi,v $ -# Revision 1.5 1999-01-19 05:13:56 ivan +# Revision 1.6 1999-02-07 09:59:28 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:56 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -25,13 +28,13 @@ # use strict; -use vars qw( $cgi $refnum $new ); +use vars qw( $cgi $refnum $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs fields); use FS::part_referral; -use FS::CGI qw(popurl eidiot); +use FS::CGI qw(popurl); $cgi = new CGI; &cgisuidsetup($cgi); @@ -45,15 +48,18 @@ $new = new FS::part_referral ( { } ); if ( $refnum ) { - my($old)=qsearchs('part_referral',{'refnum'=>$refnum}); - eidiot("(Old) Record not found!") unless $old; - my($error)=$new->replace($old); - eidiot($error) if $error; + my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } ); + die "(Old) Record not found!" unless $old; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; } +$refnum=$new->refnum; -$refnum=$new->getfield('refnum'); -print $cgi->redirect(popurl(3). "browse/part_referral.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/part_referral.cgi"); +} diff --git a/htdocs/edit/process/part_svc.cgi b/htdocs/edit/process/part_svc.cgi index e25192c1c..0b3e2cd1c 100755 --- a/htdocs/edit/process/part_svc.cgi +++ b/htdocs/edit/process/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_svc.cgi,v 1.6 1999-01-19 05:13:57 ivan Exp $ +# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_svc.cgi,v $ -# Revision 1.6 1999-01-19 05:13:57 ivan +# Revision 1.7 1999-02-07 09:59:29 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:57 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -28,13 +31,13 @@ # use strict; -use vars qw ( $cgi $svcpart $old $new ); +use vars qw ( $cgi $svcpart $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs fields); use FS::part_svc; -use FS::CGI qw(eidiot popurl); +use FS::CGI qw(popurl); $cgi = new CGI; &cgisuidsetup($cgi); @@ -51,13 +54,16 @@ $new = new FS::part_svc ( { } ); if ( $svcpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $svcpart=$new->getfield('svcpart'); } -print $cgi->redirect(popurl(3)."browse/part_svc.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3)."browse/part_svc.cgi"); +} diff --git a/htdocs/edit/process/svc_acct.cgi b/htdocs/edit/process/svc_acct.cgi index 7fd87ea84..ba231ece3 100755 --- a/htdocs/edit/process/svc_acct.cgi +++ b/htdocs/edit/process/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct.cgi,v 1.4 1999-01-19 05:13:58 ivan Exp $ +# $Id: svc_acct.cgi,v 1.5 1999-02-07 09:59:30 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi @@ -23,7 +23,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: svc_acct.cgi,v $ -# Revision 1.4 1999-01-19 05:13:58 ivan +# Revision 1.5 1999-02-07 09:59:30 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:58 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -35,11 +38,11 @@ # use strict; -use vars qw( $cgi $svcnum $old $new ); +use vars qw( $cgi $svcnum $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(eidiot popurl); +use FS::CGI qw(popurl); use FS::Record qw(qsearchs fields); use FS::svc_acct; @@ -68,15 +71,16 @@ $new = new FS::svc_acct ( { } ); if ( $svcnum ) { - my($error) = $new->replace($old); - &eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error) = $new->insert; - &eidiot($error) if $error; - $svcnum = $new->getfield('svcnum'); + $error = $new->insert; + $svcnum = $new->svcnum; } -#no errors, view account -print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); - +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); +} diff --git a/htdocs/edit/process/svc_acct_pop.cgi b/htdocs/edit/process/svc_acct_pop.cgi index 414c6fb28..763bca4a8 100755 --- a/htdocs/edit/process/svc_acct_pop.cgi +++ b/htdocs/edit/process/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_pop.cgi,v 1.5 1999-01-19 05:13:59 ivan Exp $ +# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: svc_acct_pop.cgi,v $ -# Revision 1.5 1999-01-19 05:13:59 ivan +# Revision 1.6 1999-02-07 09:59:31 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:59 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -25,13 +28,13 @@ # use strict; -use vars qw( $cgi $popnum $old $new ); +use vars qw( $cgi $popnum $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs fields); use FS::svc_acct_pop; -use FS::CGI qw(popurl eidiot); +use FS::CGI qw(popurl); $cgi = new CGI; # create form object @@ -48,12 +51,16 @@ $new = new FS::svc_acct_pop ( { } ); if ( $popnum ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $popnum=$new->getfield('popnum'); } -print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi"); + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi"); +} diff --git a/htdocs/edit/process/svc_acct_sm.cgi b/htdocs/edit/process/svc_acct_sm.cgi index 53650c888..5fefeafdb 100755 --- a/htdocs/edit/process/svc_acct_sm.cgi +++ b/htdocs/edit/process/svc_acct_sm.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_sm.cgi,v 1.4 1999-01-19 05:14:00 ivan Exp $ +# $Id: svc_acct_sm.cgi,v 1.5 1999-02-07 09:59:32 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct_sm.cgi @@ -24,7 +24,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: svc_acct_sm.cgi,v $ -# Revision 1.4 1999-01-19 05:14:00 ivan +# Revision 1.5 1999-02-07 09:59:32 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:00 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -42,6 +45,7 @@ use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs fields); use FS::svc_acct_sm; +use FS::CGI qw(popurl); $cgi = new CGI; cgisuidsetup($cgi); @@ -52,14 +56,14 @@ $svcnum =$1; $old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; #unmunge domsvc and domuid -$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); -$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); +#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); +#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); $new = new FS::svc_acct_sm ( { map { ($_, scalar($cgi->param($_))); #} qw(svcnum pkgnum svcpart domuser domuid domsvc) - } ( fields('svc_acct_sm'), qw( pkgnum svcpart) ) + } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) ) } ); if ( $svcnum ) { @@ -69,9 +73,10 @@ if ( $svcnum ) { $svcnum = $new->getfield('svcnum'); } -unless ($error) { - print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string ); } else { - idiot($error); + print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum"); } diff --git a/htdocs/edit/process/svc_domain.cgi b/htdocs/edit/process/svc_domain.cgi index 4c96823e2..fe3c6f7a1 100755 --- a/htdocs/edit/process/svc_domain.cgi +++ b/htdocs/edit/process/svc_domain.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_domain.cgi,v 1.4 1999-01-19 05:14:01 ivan Exp $ +# $Id: svc_domain.cgi,v 1.5 1999-02-07 09:59:33 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi @@ -20,7 +20,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: svc_domain.cgi,v $ -# Revision 1.4 1999-01-19 05:14:01 ivan +# Revision 1.5 1999-02-07 09:59:33 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:01 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -36,8 +39,9 @@ use vars qw( $cgi $svcnum $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearchs fields); use FS::svc_domain; +use FS::CGI qw(popurl); #remove this to actually test the domains! $FS::svc_domain::whois_hack = 1; @@ -66,9 +70,10 @@ if ($cgi->param('legal') ne "Yes") { $svcnum=$new->svcnum; } -unless ($error) { - print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string ); } else { - idiot($error); + print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); } |