diff options
Diffstat (limited to 'htdocs/edit')
-rwxr-xr-x | htdocs/edit/cust_pkg.cgi | 89 | ||||
-rwxr-xr-x | htdocs/edit/part_pkg.cgi | 67 | ||||
-rwxr-xr-x | htdocs/edit/part_referral.cgi | 24 | ||||
-rwxr-xr-x | htdocs/edit/part_svc.cgi | 27 | ||||
-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 | ||||
-rwxr-xr-x | htdocs/edit/svc_acct.cgi | 102 | ||||
-rwxr-xr-x | htdocs/edit/svc_acct_pop.cgi | 35 | ||||
-rwxr-xr-x | htdocs/edit/svc_acct_sm.cgi | 93 | ||||
-rwxr-xr-x | htdocs/edit/svc_domain.cgi | 103 |
16 files changed, 468 insertions, 314 deletions
diff --git a/htdocs/edit/cust_pkg.cgi b/htdocs/edit/cust_pkg.cgi index ed4200830..afe6f8770 100755 --- a/htdocs/edit/cust_pkg.cgi +++ b/htdocs/edit/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cust_pkg.cgi,v 1.4 1999-01-19 05:13:38 ivan Exp $ +# $Id: cust_pkg.cgi,v 1.5 1999-02-07 09:59:18 ivan Exp $ # # this is for changing packages around, not editing things within the package # @@ -25,7 +25,10 @@ # 98-jun-1 # # $Log: cust_pkg.cgi,v $ -# Revision 1.4 1999-01-19 05:13:38 ivan +# Revision 1.5 1999-02-07 09:59:18 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:38 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -38,60 +41,62 @@ # use strict; -use vars qw( $cgi %pkg %comment $query $custnum $otaker $p1 @cust_pkg - $cust_main $agent $type_pkgs $count ); +use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg + $cust_main $agent $type_pkgs $count %remove_pkg ); use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup getotaker); +use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); use FS::CGI qw(header popurl); use FS::part_pkg; - -$cgi = new CGI; -&cgisuidsetup($cgi); +use FS::type_pkgs; foreach (qsearch('part_pkg', {})) { $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg'); $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment'); } -#untaint custnum - -($query) = $cgi->keywords; -$query =~ /^(\d+)$/; -$custnum = $1; +$cgi = new CGI; +&cgisuidsetup($cgi); -$otaker = &getotaker; +if ( $cgi->param('error') ) { + $custnum = $cgi->param('custnum'); + %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg'); +} else { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + undef %remove_pkg; +} $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''), <<END; - <FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST> - <HR> -END +print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -#custnum -print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!; +print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!; -#current packages (except cancelled packages) -@cust_pkg = grep ! $_->getfield('cancel'), - qsearch('cust_pkg',{'custnum'=>$custnum}); +print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; + +#current packages +@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } ); if (@cust_pkg) { print <<END; -<CENTER><FONT SIZE="+2">Current packages</FONT></CENTER> -These are packages the customer currently has. Select those packages you -wish to remove (if any).<BR><BR> +Current packages - select to remove (services are moved to a new package below) +<BR><BR> END my ($count) = 0 ; - print qq!<CENTER><TABLE>! ; + print qq!<TABLE>! ; foreach (@cust_pkg) { - print qq!<TR>! if ($count ==0) ; + print '<TR>' if $count == 0; my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') ); - print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum">!, - #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!, - #now you've got to admit this bug was pretty cool - qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!; + print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!; + print " CHECKED" if $remove_pkg{$pkgnum}; + print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!; $count ++ ; if ($count == 2) { @@ -99,28 +104,25 @@ END print qq!</TR>\n! ; } } - print qq!</TABLE></CENTER>! ; - - print "<HR>"; + print qq!</TABLE><BR><BR>!; } print <<END; -<CENTER><FONT SIZE="+2">New packages</FONT></CENTER> -These are packages the customer can purchase. Specify the quantity to add -of each package.<BR><BR> +Order new packages<BR><BR> END $cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); $agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); $count = 0 ; -print qq!<CENTER><TABLE>! ; +print qq!<TABLE>! ; foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { my($pkgpart)=$type_pkgs->pkgpart; print qq!<TR>! if ($count == 0) ; + my $value = $cgi->param("pkg$pkgpart") || 0; print <<END; <TD> - <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2"> + <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2"> $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n END $count ++ ; @@ -130,13 +132,10 @@ END $count = 0 ; } } -print qq!</TABLE></CENTER>! ; - -#otaker -print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!; +print qq!</TABLE>! ; #submit -print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!; +print qq!<P><INPUT TYPE="submit" VALUE="Order">\n!; print <<END; </FORM> diff --git a/htdocs/edit/part_pkg.cgi b/htdocs/edit/part_pkg.cgi index e7ac2aeb2..f7ade88c8 100755 --- a/htdocs/edit/part_pkg.cgi +++ b/htdocs/edit/part_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_pkg.cgi,v 1.8 1999-01-19 05:13:39 ivan Exp $ +# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $ # # part_pkg.cgi: Add/Edit package (output form) # @@ -13,7 +13,10 @@ # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 # # $Log: part_pkg.cgi,v $ -# Revision 1.8 1999-01-19 05:13:39 ivan +# Revision 1.9 1999-02-07 09:59:19 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.8 1999/01/19 05:13:39 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -42,7 +45,7 @@ use vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; @@ -64,24 +67,36 @@ if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { } ($query) = $cgi->keywords; +$action = ''; +$part_pkg = ''; +if ( $cgi->param('error') ) { + $part_pkg = new FS::part_pkg ( { + map { $_, scalar($cgi->param($_)) } fields('part_pkg') + } ); +} if ( $cgi->param('clone') ) { $action='Custom Pricing'; my $old_part_pkg = qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } ); - $part_pkg = $old_part_pkg->clone; -} elsif ( $query =~ /^(\d+)$/ ) { - $action='Edit'; - $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1}); + $part_pkg ||= $old_part_pkg->clone; +} elsif ( $query && $query =~ /^(\d+)$/ ) { + $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1}); } else { - $action='Add'; - $part_pkg = new FS::part_pkg {}; + $part_pkg ||= new FS::part_pkg {}; } +$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add'; $hashref = $part_pkg->hashref; print $cgi->header( '-expires' => 'now' ), header("$action Package Definition", menubar( 'Main Menu' => popurl(2), 'View all packages' => popurl(2). 'browse/part_pkg.cgi', -)), '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; if ( $cgi->param('clone') ) { print qq!<INPUT TYPE="hidden" NAME="clone" VALUE="!, $cgi->param('clone'), qq!">!; @@ -113,34 +128,34 @@ Enter the quantity of each service this package includes.<BR><BR> END } -foreach $part_svc ( qsearch('part_svc',{}) ) { - - my($svcpart)=$part_svc->getfield('svcpart'); - my($pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $cgi->param('clone') || $part_pkg->getfield('pkgpart'), +$count = 0; +foreach $part_svc ( ( qsearch( 'part_svc', {} ) ) ) { + my $svcpart = $part_svc->svcpart; + my $pkg_svc = qsearchs( 'pkg_svc', { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, 'svcpart' => $svcpart, - }) || new FS::pkg_svc({ - 'pkgpart' => $part_pkg->getfield('pkgpart'), + } ) || new FS::pkg_svc ( { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, 'svcpart' => $svcpart, 'quantity' => 0, }); - next unless $pkg_svc; + #? #next unless $pkg_svc; - unless ( $cgi->param('clone') ) { - print qq!<TR>! if $count == 0 ; + unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) { + print '<TR>' if $count == 0 ; print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!, - $pkg_svc->getfield('quantity') || 0,qq!"></TD>!, - qq!<TD><A HREF="part_svc.cgi?!,$part_svc->getfield('svcpart'), + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, + qq!"></TD><TD><A HREF="part_svc.cgi?!,$part_svc->svcpart, qq!">!, $part_svc->getfield('svc'), "</A></TD>"; - $count ++ ; + $count++; if ($count == 2) { - print qq!</TR>! ; - $count = 0 ; + print '</TR>'; + $count = 0; } } else { print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!, - $pkg_svc->getfield('quantity') || 0, qq!">\n!; + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!; } } diff --git a/htdocs/edit/part_referral.cgi b/htdocs/edit/part_referral.cgi index 6fd75f851..ed3b2678e 100755 --- a/htdocs/edit/part_referral.cgi +++ b/htdocs/edit/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_referral.cgi,v 1.4 1999-01-19 05:13:41 ivan Exp $ +# $Id: part_referral.cgi,v 1.5 1999-02-07 09:59:20 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -12,7 +12,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_referral.cgi,v $ -# Revision 1.4 1999-01-19 05:13:41 ivan +# Revision 1.5 1999-02-07 09:59:20 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:41 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -25,19 +28,20 @@ # use strict; -use vars qw( $cgi $part_referral $action $hashref $p1 ); +use vars qw( $cgi $part_referral $action $hashref $p1 $query ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); use FS::part_referral; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); $cgi = new CGI; &cgisuidsetup($cgi); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +($query) = $cgi->keywords; +if ( $query =~ /^(\d+)$/ ) { #editing $part_referral=qsearchs('part_referral',{'refnum'=>$1}); $action='Edit'; } else { #adding @@ -50,11 +54,13 @@ $p1 = popurl(1); print $cgi->header( '-expires' => 'now' ), header("$action Referral", menubar( 'Main Menu' => popurl(2), 'View all referrals' => popurl(2). "browse/part_referral.cgi", -)), <<END; - <FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST> -END +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -#display +print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!; print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!, "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)"; diff --git a/htdocs/edit/part_svc.cgi b/htdocs/edit/part_svc.cgi index 58a1e048e..8a39fc7a9 100755 --- a/htdocs/edit/part_svc.cgi +++ b/htdocs/edit/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_svc.cgi,v 1.7 1999-01-19 05:13:42 ivan Exp $ +# $Id: part_svc.cgi,v 1.8 1999-02-07 09:59:21 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -10,7 +10,10 @@ # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 # # $Log: part_svc.cgi,v $ -# Revision 1.7 1999-01-19 05:13:42 ivan +# Revision 1.8 1999-02-07 09:59:21 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:42 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -41,21 +44,31 @@ $cgi = new CGI; &cgisuidsetup($cgi); -($query) = $cgi->keywords; -if ( $query && $query =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $part_svc = new FS::part_svc ( { + map { $_, scalar($cgi->param($_)) } fields('part_svc') + } ); +} elsif ( $cgi->keywords ) { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; $part_svc=qsearchs('part_svc',{'svcpart'=>$1}); - $action='Edit'; } else { #adding $part_svc = new FS::part_svc {}; - $action='Add'; } +$action = $part_svc->svcpart ? 'Edit' : 'Add'; $hashref = $part_svc->hashref; $p = popurl(2); print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar( 'Main Menu' => $p, 'View all services' => "${p}browse/part_svc.cgi", -)), '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>'; +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>'; print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!, "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)"; 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"); } diff --git a/htdocs/edit/svc_acct.cgi b/htdocs/edit/svc_acct.cgi index af18654ac..876d7be5a 100755 --- a/htdocs/edit/svc_acct.cgi +++ b/htdocs/edit/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct.cgi,v 1.6 1999-01-19 05:13:43 ivan Exp $ +# $Id: svc_acct.cgi,v 1.7 1999-02-07 09:59:22 ivan Exp $ # # Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} @@ -18,7 +18,10 @@ # use conf/shells and dbdef username length ivan@sisd.com 98-jul-13 # # $Log: svc_acct.cgi,v $ -# Revision 1.6 1999-01-19 05:13:43 ivan +# Revision 1.7 1999-02-07 09:59:22 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:43 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -35,7 +38,7 @@ use strict; use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart - $part_svc $query $svc $otaker $username $password $ulen $ulen2 $p1 + $part_svc $svc $otaker $username $password $ulen $ulen2 $p1 $popnum $uid $gid $finger $dir $shell $quota $slipip ); use CGI; use CGI::Carp qw(fatalsToBrowser); @@ -51,57 +54,64 @@ $cgi = new CGI; $conf = new FS::Conf; @shells = $conf->config('shells'); -($query) = $cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; - - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; - +if ( $cgi->param('error') ) { + $svc_acct = new FS::svc_acct ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct') + } ); + $svcnum = $svc_acct->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct) svcnum!"; - $action="Edit"; - -} else { #adding + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $svc_acct = new FS::svc_acct({}); + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - foreach $_ (split(/-/,$query)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $svcnum=''; + } else { #adding - #set gecos - my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); - if ($cust_pkg) { - my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } ); - $svc_acct->setfield('finger', - $cust_main->getfield('first') . " " . $cust_main->getfield('last') - ) ; - } + $svc_acct = new FS::svc_acct({}); - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct') ) { - if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) { - $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) ); + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + $svcnum=''; + + #set gecos + my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); + if ($cust_pkg) { + my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } ); + $svc_acct->setfield('finger', + $cust_main->getfield('first') . " " . $cust_main->getfield('last') + ) ; } - } - $action="Add"; + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct') ) { + if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) { + $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) ); + } + } + } } +$action = $svcnum ? 'Edit' : 'Add'; $svc = $part_svc->getfield('svc'); @@ -116,7 +126,13 @@ $ulen = $svc_acct->dbdef_table->column('username')->length; $ulen2 = $ulen+2; $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("$action $svc account"), <<END; +print $cgi->header( '-expires' => 'now' ), header("$action $svc account"); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> diff --git a/htdocs/edit/svc_acct_pop.cgi b/htdocs/edit/svc_acct_pop.cgi index 115c46745..41a163ebb 100755 --- a/htdocs/edit/svc_acct_pop.cgi +++ b/htdocs/edit/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_pop.cgi,v 1.6 1999-01-19 05:13:44 ivan Exp $ +# $Id: svc_acct_pop.cgi,v 1.7 1999-02-07 09:59:23 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.6 1999-01-19 05:13:44 ivan +# Revision 1.7 1999-02-07 09:59:23 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:44 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -34,31 +37,39 @@ use vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::svc_acct_pop; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); $cgi = new CGI; &cgisuidsetup($cgi); -($query)=$cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $svc_acct_pop = new FS::svc_acct_pop ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop') + } ); +} elsif ( $cgi->keywords ) { #editing + my($query)=$cgi->keywords; + $query =~ /^(\d+)$/; $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1}); - $action='Edit'; } else { #adding $svc_acct_pop = new FS::svc_acct_pop {}; - $action='Add'; } +$action = $svc_acct_pop->popnum ? 'Edit' : 'Add'; $hashref = $svc_acct_pop->hashref; $p1 = popurl(1); print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar( 'Main Menu' => popurl(2), 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi", -)), <<END; - <FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST> -END +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!; #display @@ -68,7 +79,7 @@ print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!, print <<END; <PRE> City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}"> -State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 VALUE="$hashref->{state}"> +State <INPUT TYPE="text" NAME="state" SIZE=16 MAXLENGTH=16 VALUE="$hashref->{state}"> Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}"> Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}"> </PRE> diff --git a/htdocs/edit/svc_acct_sm.cgi b/htdocs/edit/svc_acct_sm.cgi index 0de4fa1ac..d68d67c3a 100755 --- a/htdocs/edit/svc_acct_sm.cgi +++ b/htdocs/edit/svc_acct_sm.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_sm.cgi,v 1.7 1999-01-19 05:13:45 ivan Exp $ +# $Id: svc_acct_sm.cgi,v 1.8 1999-02-07 09:59:24 ivan Exp $ # # Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} @@ -35,7 +35,10 @@ # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26 # # $Log: svc_acct_sm.cgi,v $ -# Revision 1.7 1999-01-19 05:13:45 ivan +# Revision 1.8 1999-02-07 09:59:24 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:45 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -73,49 +76,55 @@ $cgi = new CGI; $conf = new FS::Conf; $mydomain = $conf->config('domain'); - -($query) = $cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct_sm) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; - - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; - +if ( $cgi->param('error') ) { + $svc_acct_sm = new FS::svc_acct_sm ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm') + } ); + $svcnum = $svc_acct_sm->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct_sm) svcnum!"; - $action="Edit"; - -} else { #adding + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $svc_acct_sm = new FS::svc_acct_sm({}); + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + } else { #adding - $svcnum=''; + $svc_acct_sm = new FS::svc_acct_sm({}); - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct_sm') ) { - if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { - $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; } - } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $action='Add'; + $svcnum=''; + + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct_sm') ) { + if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { + $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + } + } + } } +$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add'; if ($pkgnum) { @@ -175,9 +184,13 @@ if ($pkgnum) { } $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", ''), <<END; - <FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST> -END +print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST>!; #display @@ -206,14 +219,16 @@ print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * #domsvc print qq! \@ <SELECT NAME="domsvc" SIZE=1>!; foreach $_ (keys %domain) { - print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}"; + print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", + qq! VALUE="$_">$domain{$_}!; } print "</SELECT>"; #uid print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!; foreach $_ (keys %username) { - print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}"; + print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", + qq! VALUE="$_">$username{$_}!; } print "</SELECT>\@$mydomain mailbox."; diff --git a/htdocs/edit/svc_domain.cgi b/htdocs/edit/svc_domain.cgi index 45ff8bb6c..05cabba2b 100755 --- a/htdocs/edit/svc_domain.cgi +++ b/htdocs/edit/svc_domain.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_domain.cgi,v 1.7 1999-01-19 05:13:46 ivan Exp $ +# $Id: svc_domain.cgi,v 1.8 1999-02-07 09:59:25 ivan Exp $ # # Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart} @@ -17,7 +17,10 @@ # no GOV in instructions ivan@sisd.com 98-jul-17 # # $Log: svc_domain.cgi,v $ -# Revision 1.7 1999-01-19 05:13:46 ivan +# Revision 1.8 1999-02-07 09:59:25 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:46 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -41,7 +44,7 @@ use strict; use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc - $query $svc $otaker $domain $p1 ); + $svc $otaker $domain $p1 $kludge_action $purpose ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); @@ -52,48 +55,59 @@ use FS::svc_domain; $cgi = new CGI; &cgisuidsetup($cgi); -($query) = $cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) - or die "Unknown (svc_domain) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +if ( $cgi->param('error') ) { + $svc_domain = new FS::svc_domain ( { + map { $_, scalar($cgi->param($_)) } fields('svc_domain') + } ); + $svcnum = $svc_domain->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); + $kludge_action = $cgi->param('action'); + $purpose = $cgi->param('purpose'); + $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); + die "No part_svc entry!" unless $part_svc; +} else { + $kludge_action = ''; + $purpose = ''; + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) + or die "Unknown (svc_domain) svcnum!"; - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $action="Edit"; + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; -} else { #adding + } else { #adding - $svc_domain = new FS::svc_domain({}); + $svc_domain = new FS::svc_domain({}); - foreach $_ (split(/-/,$query)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $svcnum=''; + $svcnum=''; - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_domain') ) { - if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { - $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_domain') ) { + if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { + $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + } } - } - - $action="Add"; + } } +$action = $svcnum ? 'Edit' : 'Add'; $svc = $part_svc->getfield('svc'); @@ -102,20 +116,33 @@ $otaker = getotaker; $domain = $svc_domain->domain; $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''), <<END; +print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> - <INPUT TYPE="radio" NAME="action" VALUE="N">New - <BR><INPUT TYPE="radio" NAME="action" VALUE="M">Transfer +END + +print qq!<INPUT TYPE="radio" NAME="action" VALUE="N"!; +print ' CHECKED' if $kludge_action eq 'N'; +print qq!>New!; +print qq!<BR><INPUT TYPE="radio" NAME="action" VALUE="M"!; +print ' CHECKED' if $kludge_action eq 'M'; +print qq!>Transfer!; +print <<END; <P>Customer agrees to be bound by NSI's <A HREF="http://rs.internic.net/help/agreement.txt"> Domain Name Registration Agreement</A> <SELECT NAME="legal" SIZE=1><OPTION SELECTED>No<OPTION>Yes</SELECT> <P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26> -<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="" SIZE=64> +<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="$purpose" SIZE=64> <P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER> <UL> <LI>COM is for commercial, for-profit organziations |