diff options
Diffstat (limited to 'htdocs/edit')
30 files changed, 2288 insertions, 1115 deletions
diff --git a/htdocs/edit/agent.cgi b/htdocs/edit/agent.cgi index 5bd116528..5b42095b3 100755 --- a/htdocs/edit/agent.cgi +++ b/htdocs/edit/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: Add/Edit agent (output form) +# $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -9,38 +9,70 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: agent.cgi,v $ +# Revision 1.7 1999-04-07 11:27:50 ivan +# avoid perl's silly arguement not numeric error +# +# Revision 1.6 1999/01/25 12:09:50 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:31 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:21 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:16:57 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/23 07:52:08 ivan +# *** empty log message *** +# use strict; -use CGI::Base; +use vars qw ( $cgi $agent $action $hashref $p $agent_type ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(header menubar popurl); +use FS::Record qw(qsearch qsearchs fields); use FS::agent; -use FS::CGI qw(header menubar); +use FS::agent_type; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($agent,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $agent=qsearchs('agent',{'agentnum'=>$1}); - $action='Edit'; +if ( $cgi->param('error') ) { + $agent = new FS::agent ( { + map { $_, scalar($cgi->param($_)) } fields('agent') + } ); +} elsif ( $cgi->keywords ) { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $agent = qsearchs( 'agent', { 'agentnum' => $1 } ); } else { #adding - $agent=create FS::agent {}; - $action='Add'; + $agent = new FS::agent {}; } -my($hashref)=$agent->hashref; +$action = $agent->agentnum ? 'Edit' : 'Add'; +$hashref = $agent->hashref; + +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("$action Agent", menubar( + 'Main Menu' => $p, + 'View all agents' => $p. 'browse/agent.cgi', +)); -print header("$action Agent", menubar( - 'Main Menu' => '../', - 'View all agents' => '../browse/agent.cgi', -)), '<FORM ACTION="process/agent.cgi" METHOD=POST>'; +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!, +print '<FORM ACTION="', popurl(1), 'process/agent.cgi" METHOD=POST>', + qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!, "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)"; print <<END; @@ -49,11 +81,10 @@ Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashre Agent type <SELECT NAME="typenum" SIZE=1> END -my($agent_type); foreach $agent_type (qsearch('agent_type',{})) { - print "<OPTION"; + print "<OPTION VALUE=". $agent_type->typenum; print " SELECTED" - if $hashref->{typenum} == $agent_type->getfield('typenum'); + if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum ); print ">", $agent_type->getfield('typenum'), ": ", $agent_type->getfield('atype'),"\n"; } diff --git a/htdocs/edit/agent_type.cgi b/htdocs/edit/agent_type.cgi index b9fff4530..bdf64c58f 100755 --- a/htdocs/edit/agent_type.cgi +++ b/htdocs/edit/agent_type.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: agent_type.cgi,v 1.11 1999-04-07 11:19:21 ivan Exp $ +# # agent_type.cgi: Add/Edit agent type (output form) # # ivan@sisd.com 97-dec-10 @@ -9,46 +11,91 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: agent_type.cgi,v $ +# Revision 1.11 1999-04-07 11:19:21 ivan +# silly HTML typo +# +# Revision 1.10 1999/01/25 12:09:51 ivan +# yet more mod_perl stuff +# +# Revision 1.9 1999/01/19 05:13:32 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.8 1999/01/18 09:41:22 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.7 1999/01/18 09:22:29 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.6 1998/12/17 06:16:58 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.5 1998/11/21 07:58:27 ivan +# package names link to them +# +# Revision 1.4 1998/11/21 07:45:19 ivan +# visual, use FS::table_name when doing qsearch('table_name') +# +# Revision 1.3 1998/11/15 11:20:12 ivan +# s/CGI-Base/CGI.pm/ causes s/QUERY_STRING/keywords/; +# +# Revision 1.2 1998/11/13 09:56:46 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base; +use vars qw( $cgi $agent_type $action $hashref $p $part_pkg ); +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::agent_type; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); +use FS::agent_type; +use FS::part_pkg; +use FS::type_pkgs; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($agent_type,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $agent_type = new FS::agent_type ( { + map { $_, scalar($cgi->param($_)) } fields('agent') + } ); +} elsif ( $cgi->keywords ) { #editing + my( $query ) = $cgi->keywords; + $query =~ /^(\d+)$/; $agent_type=qsearchs('agent_type',{'typenum'=>$1}); - $action='Edit'; } else { #adding - $agent_type=create FS::agent_type {}; - $action='Add'; + $agent_type = new FS::agent_type {}; } -my($hashref)=$agent_type->hashref; +$action = $agent_type->typenum ? 'Edit' : 'Add'; +$hashref = $agent_type->hashref; + +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Agent Type", menubar( + 'Main Menu' => "$p", + 'View all agent types' => "${p}browse/agent_type.cgi", +)); -print header("$action Agent Type", menubar( - 'Main Menu' => '../', - 'View all agent types' => '../browse/agent_type.cgi', -)), '<FORM ACTION="process/agent_type.cgi" METHOD=POST>'; +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!, +print '<FORM ACTION="', popurl(1), 'process/agent_type.cgi" METHOD=POST>', + qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!, "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)"; print <<END; -<BR>Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}"> -<P>Select which packages agents of this type may sell to customers</P> +<BR><BR>Agent Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}"> +<BR><BR>Select which packages agents of this type may sell to customers<BR> END -my($part_pkg); foreach $part_pkg ( qsearch('part_pkg',{}) ) { print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!, $part_pkg->getfield('pkgpart'), qq!" !, @@ -59,7 +106,9 @@ foreach $part_pkg ( qsearch('part_pkg',{}) ) { }) ? 'CHECKED ' : '', - qq!"VALUE="ON"> !,$part_pkg->getfield('pkg') + qq!VALUE="ON"> !, + qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart, + '">', $part_pkg->getfield('pkg'), '</A>', ; } diff --git a/htdocs/edit/cust_credit.cgi b/htdocs/edit/cust_credit.cgi index 75ef21208..35c4d48fe 100755 --- a/htdocs/edit/cust_credit.cgi +++ b/htdocs/edit/cust_credit.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_credit.cgi: Add a credit (output form) +# $Id: cust_credit.cgi,v 1.7 1999-02-28 00:03:33 ivan Exp $ # # Usage: cust_credit.cgi custnum [ -paybatch ] # http://server.name/path/cust_credit?custnum [ -paybatch ] # -# Note: Should be run setuid root as user nobody. -# # some hooks in here for modifications as well as additions, but needs (lots) more work. # also see process/cust_credit.cgi, the script that processes the form. # @@ -23,63 +21,89 @@ # ivan@voicenet.com 97-apr-21 # # rewrite ivan@sisd.com 98-mar-16 +# +# $Log: cust_credit.cgi,v $ +# Revision 1.7 1999-02-28 00:03:33 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:09:52 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:33 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:23 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/23 02:26:06 ivan +# *** empty log message *** +# +# Revision 1.2 1998/12/17 06:16:59 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; +use vars qw( $cgi $query $custnum $otaker $p1 $crednum $_date $amount $reason ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); #CGI module +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw(header popurl); +use FS::Record qw(fields); +#use FS::cust_credit; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint custnum -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; - -#untaint otaker -my($otaker)=getotaker; - -SendHeaders(); # one guess. +if ( $cgi->param('error') ) { + #$cust_credit = new FS::cust_credit ( { + # map { $_, scalar($cgi->param($_)) } fields('cust_credit') + #} ); + $custnum = $cgi->param('custnum'); + $amount = $cgi->param('amount'); + #$refund = $cgi->param('refund'); + $reason = $cgi->param('reason'); +} else { + ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + $amount = ''; + #$refund = 'yes'; + $reason = ''; +} +$_date = time; + +$otaker = getotaker; + +$p1 = popurl(1); + +print $cgi->header( '-expires' => 'now' ), header("Post Credit", ''); +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); print <<END; -<HTML> - <HEAD> - <TITLE>Post Credit</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Post Credit</H1> - </CENTER> - <FORM ACTION="process/cust_credit.cgi" METHOD=POST> - <HR><PRE> + <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST> + <PRE> END -#crednum -my($crednum)=""; +$crednum = ""; print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!; -#custnum print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; -#paybatch print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!; -#date -my($date)=time; -print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!; +print qq!\nDate: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="">!; -#amount -my($amount)=''; print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!; +print qq!<INPUT TYPE="hidden" NAME="credited" VALUE="">!; -#refund? -#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">Also post refund!; +#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!; -#otaker (hidden) print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!; -#reason -my($reason)=''; print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!; print <<END; diff --git a/htdocs/edit/cust_main.cgi b/htdocs/edit/cust_main.cgi index 14556010c..9c61c654e 100755 --- a/htdocs/edit/cust_main.cgi +++ b/htdocs/edit/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_main.cgi: Edit a customer (output form) +# $Id: cust_main.cgi,v 1.29 2001-05-23 13:47:07 ivan Exp $ # # Usage: cust_main.cgi custnum # http://server.name/path/cust_main.cgi?custnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-nov-29 -> 96-dec-04 # # Blank custnum for new customer. @@ -38,82 +36,271 @@ # bmccane@maxbaud.net 98-apr-3 # # fixed one missed day->daytime ivan@sisd.com 98-jul-13 +# +# $Log: cust_main.cgi,v $ +# Revision 1.29 2001-05-23 13:47:07 ivan +# bugfix for defaultcountry +# +# Revision 1.28 2000/12/26 23:51:40 ivan +# statedefault & referraldefault config files +# +# Revision 1.27 2000/12/03 13:45:15 ivan +# patch from Jason Spence <thalakan@frys.com>: admin.html doc, autocapgen +# +# Revision 1.26 2000/06/27 12:15:50 ivan +# i18n +# +# Revision 1.25 2000/03/02 08:09:38 ivan +# still need to allow blank expiration dates +# +# Revision 1.24 2000/01/30 06:54:50 ivan +# credit card expiration dates not sticky bug fixed? +# +# Revision 1.23 2000/01/27 00:53:14 ivan +# 5.004_04 workaround +# +# Revision 1.22 1999/12/17 02:33:23 ivan +# argh +# +# Revision 1.21 1999/08/23 07:40:38 ivan +# missing </TD> flag +# +# Revision 1.20 1999/08/23 07:08:11 ivan +# no CGI::Switch for now +# +# Revision 1.19 1999/08/21 02:14:25 ivan +# better error message for no agents +# +# Revision 1.18 1999/08/11 15:38:33 ivan +# fix for perl 5.004_04 +# +# Revision 1.17 1999/08/10 11:15:45 ivan +# corrected a misleading comment +# +# Revision 1.15 1999/04/14 13:14:54 ivan +# configuration option to edit referrals of existing customers +# +# Revision 1.14 1999/04/14 07:47:53 ivan +# i18n fixes +# +# Revision 1.13 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.12 1999/04/06 11:16:16 ivan +# give a meaningful error message if you try to create a customer before you've +# created an agent +# +# Revision 1.11 1999/03/25 13:55:10 ivan +# one-screen new customer entry (including package and service) for simple +# packages with one svc_acct service +# +# Revision 1.10 1999/02/28 00:03:34 ivan +# removed misleading comments +# +# Revision 1.9 1999/02/23 08:09:20 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.8 1999/01/25 12:09:53 ivan +# yet more mod_perl stuff +# +# Revision 1.7 1999/01/19 05:13:34 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:24 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1999/01/18 09:22:30 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.4 1998/12/23 08:08:15 ivan +# fix typo +# +# Revision 1.3 1998/12/17 06:17:00 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base; +use vars qw( $cgi $custnum $action $cust_main $p1 @agents $agentnum + $last $first $ss $company $address1 $address2 $city $zip + $daytime $night $fax @invoicing_list $invoicing_list $payinfo + $payname %payby %paybychecked $refnum $otaker $r ); +use vars qw ( $conf $pkgpart $username $password $popnum $ulen $ulen2 ); +#use CGI::Switch; +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); +#use FS::Record qw(qsearch qsearchs fields); +use FS::Record qw(qsearch qsearchs fields dbdef); +use FS::CGI qw(header popurl itable table); use FS::cust_main; +use FS::agent; +use FS::part_referral; +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; + #for misplaced logic below + use FS::part_pkg; + #for false laziness below + use FS::svc_acct_pop; + + #for (other) false laziness below + use FS::agent; + use FS::type_pkgs; + +$cgi = new CGI; cgisuidsetup($cgi); -SendHeaders(); # one guess. +$conf = new FS::Conf; #get record -my($custnum,$action,$cust_main); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing + +if ( $cgi->param('error') ) { + $cust_main = new FS::cust_main ( { + map { $_, scalar($cgi->param($_)) } fields('cust_main') + } ); + $custnum = $cust_main->custnum; + $pkgpart = $cgi->param('pkgpart_svcpart') || ''; + if ( $pkgpart =~ /^(\d+)_/ ) { + $pkgpart = $1; + } else { + $pkgpart = ''; + } + $username = $cgi->param('username'); + $password = $cgi->param('_password'); + $popnum = $cgi->param('popnum'); +} elsif ( $cgi->keywords ) { #editing + my( $query ) = $cgi->keywords; + $query =~ /^(\d+)$/; $custnum=$1; - $cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); - $action='Edit'; + $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); + $pkgpart = 0; + $username = ''; + $password = ''; + $popnum = 0; } else { $custnum=''; - $cust_main = create FS::cust_main ( {} ); + $cust_main = new FS::cust_main ( {} ); $cust_main->setfield('otaker',&getotaker); - $cust_main->setfield('country','US'); - $action='Add'; + $pkgpart = 0; + $username = ''; + $password = ''; + $popnum = 0; } - -print <<END; -<HTML> - <HEAD> - <TITLE>Customer $action</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Customer $action</H1> - </CENTER> - <FORM ACTION="process/cust_main.cgi" METHOD=POST> - <PRE> +$action = $custnum ? 'Edit' : 'Add'; + +# top + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Customer $action", ''); +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +# JRS: Javascript to set up the form for us + if ( $conf->exists('autocapnames') ) { + print <<END; +<SCRIPT language="Javascript"><!-- + +function capName(name) { + var temp = new String(); + var n = name.toString(); + +// Handle "Mc", "Mac", "Von", "Van", etc... + + if(n.substr(0,2).toLowerCase() == "mc") { + temp += "Mc"; + temp += n.charAt(2).toUpperCase(); + temp += n.substr(3).toLowerCase(); + return temp; + } + + if(n.substr(0,3).toLowerCase() == "mac") { + temp += "Mac"; + temp += n.charAt(3).toUpperCase(); + temp += n.substr(4).toLowerCase(); + return temp; + } + if(n.substr(0,3).toLowerCase() == "von") { + temp += "Von"; + temp += n.charAt(3).toUpperCase(); + temp += n.substr(4).toLowerCase(); + return temp; + } + if(n.substr(0,3).toLowerCase() == "van") { + temp += "Van"; + temp += n.charAt(3).toUpperCase(); + temp += n.substr(4).toLowerCase(); + return temp; + } + temp += n.charAt(0).toUpperCase(); + temp += n.substr(1).toLowerCase(); + return temp; +} + +//--> +</SCRIPT> END +} + +print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST NAME="form1">!, + qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!, + qq!Customer # !, ( $custnum ? $custnum : " (NEW)" ), + +; + +# agent + +$r = qq!<font color="#ff0000">*</font>!; -print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!, - qq!Customer #<FONT SIZE="+1"><B>!; -print $custnum ? $custnum : " (NEW)" , "</B></FONT>"; - -#agentnum -my($agentnum)=$cust_main->agentnum || 1; #set to first agent by default -my(@agents) = qsearch('agent',{}); -print qq!\n\nAgent # <SELECT NAME="agentnum" SIZE="1">!; -my($agent); -foreach $agent (sort { - $a->agent cmp $b->agent; -} @agents) { - print "<OPTION" . " SELECTED"x($agent->agentnum==$agentnum), - ">", $agent->agentnum,": ", $agent->agent, "\n"; +@agents = qsearch( 'agent', {} ); +#die "No agents created!" unless @agents; +die "You have not created any agents. You must create at least one agent before adding a customer. Go to ". popurl(2). "browse/agent.cgi and create one or more agents." unless @agents; +$agentnum = $cust_main->agentnum || $agents[0]->agentnum; #default to first +if ( scalar(@agents) == 1 ) { + print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$agentnum">!; +} else { + print qq!<BR><BR>${r}Agent <SELECT NAME="agentnum" SIZE="1">!; + my $agent; + foreach $agent (sort { + $a->agent cmp $b->agent; + } @agents) { + print '<OPTION VALUE="', $agent->agentnum, '"', + " SELECTED"x($agent->agentnum==$agentnum), + ">", $agent->agentnum,": ", $agent->agent; + } + print "</SELECT>"; } -print "</SELECT>"; #referral -#unless ($custnum) { - my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error + +$refnum = $cust_main->refnum || $conf->config('referraldefault') || 0; +if ( $custnum && ! $conf->exists('editreferrals') ) { + print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!; +} else { my(@referrals) = qsearch('part_referral',{}); - print qq!\nReferral <SELECT NAME="refnum" SIZE="1">!; - print "<OPTION> \n"; - my($referral); - foreach $referral (sort { - $a->refnum <=> $b->refnum; - } @referrals) { - print "<OPTION" . " SELECTED"x($referral->refnum==$refnum), - ">", $referral->refnum, ": ", $referral->referral,"\n"; + if ( scalar(@referrals) == 1 ) { + $refnum ||= $referrals[0]->refnum; + print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!; + } else { + print qq!<BR><BR>${r}Referral <SELECT NAME="refnum" SIZE="1">!; + print "<OPTION> " unless $refnum; + my($referral); + foreach $referral (sort { + $a->refnum <=> $b->refnum; + } @referrals) { + print "<OPTION" . " SELECTED"x($referral->refnum==$refnum), + ">", $referral->refnum, ": ", $referral->referral; + } + print "</SELECT>"; } - print "</SELECT>"; -#} +} + -my($last,$first,$ss,$company,$address1,$address2,$city)=( +# contact info + +($last,$first,$ss,$company,$address1,$address2,$city,$zip)=( $cust_main->last, $cust_main->first, $cust_main->ss, @@ -121,94 +308,209 @@ my($last,$first,$ss,$company,$address1,$address2,$city)=( $cust_main->address1, $cust_main->address2, $cust_main->city, + $cust_main->zip, ); -print <<END; +print "<BR><BR>Contact information", &itable("#c0c0c0"), <<END; +<TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3> +END +if ( $conf->exists('autocapnames') ) { + print <<END; +<INPUT TYPE="text" NAME="last" VALUE="$last" onChange="updateUsername();">, +<INPUT TYPE="text" NAME="first" VALUE="$first" onChange="updateUsername();"> +END +} else { + print <<END; +<INPUT TYPE="text" NAME="last" VALUE="$last">, +<INPUT TYPE="text" NAME="first" VALUE="$first"> +END +} -Name (last)<INPUT TYPE="text" NAME="last" VALUE="$last"> (first)<INPUT TYPE="text" NAME="first" VALUE="$first"> SS# <INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11 MAXLENGTH=11> -Company <INPUT TYPE="text" NAME="company" VALUE="$company"> -Address <INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=40 MAXLENGTH=40> - <INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=40 MAXLENGTH=40> -City <INPUT TYPE="text" NAME="city" VALUE="$city"> State (county) <SELECT NAME="state" SIZE="1"> +print <<END; +</TD><TD ALIGN="right">SS#</TD><TD><INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11></TD></TR> +<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="company" VALUE="$company" SIZE=70></TD></TR> +<TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=70></TD></TR> +<TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=70></TD></TR> +<TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="city" VALUE="$city"></TD><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1"> END +$cust_main->country( $conf->config('countrydefault') || 'US' ) + unless $cust_main->country; +$cust_main->state( $conf->config('statedefault') || 'CA' ) + unless $cust_main->state || $cust_main->country ne 'US'; foreach ( qsearch('cust_main_county',{}) ) { print "<OPTION"; print " SELECTED" if ( $cust_main->state eq $_->state - && $cust_main->county eq $_->county ); + && $cust_main->county eq $_->county + && $cust_main->country eq $_->country + ); print ">",$_->state; print " (",$_->county,")" if $_->county; + print " / ", $_->country; } -print "</SELECT>"; +print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!; -my($zip,$country,$daytime,$night,$fax)=( - $cust_main->zip, - $cust_main->country, +($daytime,$night,$fax)=( $cust_main->daytime, $cust_main->night, $cust_main->fax, ); print <<END; - Zip <INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10 MAXLENGTH=10> -Country: <FONT SIZE="+1"><B>$country</B></FONT><INPUT TYPE="hidden" NAME="country" VALUE="$country"> +<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18></TD></TR> +<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18></TD></TR> +<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12></TD></TR> +END -Phone (daytime)<INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18 MAXLENGTH=20> (night)<INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18 MAXLENGTH=20> (fax)<INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12 MAXLENGTH=12> +print "</TABLE>$r required fields<BR>"; + +# billing info + +sub expselect { + my $prefix = shift; + my( $m, $y ) = (0, 0); + if ( scalar(@_) ) { + my $date = shift || '01-2000'; + if ( $date =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format + ( $m, $y ) = ( $2, $1 ); + } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $m, $y ) = ( $1, $3 ); + } else { + die "unrecognized expiration date format: $date"; + } + } -END + my $return = qq!<SELECT NAME="$prefix!. qq!_month" SIZE="1">!; + for ( 1 .. 12 ) { + $return .= "<OPTION"; + $return .= " SELECTED" if $_ == $m; + $return .= ">$_"; + } + $return .= qq!</SELECT>/<SELECT NAME="$prefix!. qq!_year" SIZE="1">!; + for ( 2001 .. 2037 ) { + $return .= "<OPTION"; + $return .= " SELECTED" if $_ == $y; + $return .= ">$_"; + } + $return .= "</SELECT>"; -my(%payby)=( - 'CARD' => "Credit card ", - 'BILL' => "Billing ", - 'COMP' => "Complimentary", -); -for (qw(CARD BILL COMP)) { - print qq!<INPUT TYPE="radio" NAME="payby" VALUE="$_"!; - print qq! CHECKED! if ($cust_main->payby eq "$_"); - print qq!>$payby{$_}!; + $return; } - -my($payinfo,$payname,$otaker)=( +print "<BR>Billing information", &itable("#c0c0c0"), + qq!<TR><TD><INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!; +print qq! CHECKED! if $cust_main->tax eq "Y"; +print qq!>Tax Exempt</TD></TR>!; +print qq!<TR><TD><INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"!; +@invoicing_list = $cust_main->invoicing_list; +print qq! CHECKED! + if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list; +print qq!>Postal mail invoice</TD></TR>!; +$invoicing_list = join(', ', grep { $_ ne 'POST' } @invoicing_list ); +print qq!<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="$invoicing_list"></TD></TR>!; + +print "<TR><TD>Billing type</TD></TR>", + "</TABLE>", + &table("#c0c0c0"), "<TR>"; + +($payinfo, $payname)=( $cust_main->payinfo, $cust_main->payname, - $cust_main->otaker, ); -my($paydate); -if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { - $paydate="$2/$1" -} elsif ( $cust_main->paydate =~ /^(\d{2})-\d{2}-(\d{4}$)/ ) { - $paydate="$1/$2" -} -else { - $paydate=''; +%payby = ( + 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!, + 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR>${r}Exp !. expselect("BILL", "12-2037"). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!, + 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"), +); +%paybychecked = ( + 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!, + 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("BILL", $cust_main->paydate). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!, + 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate), +); +for (qw(CARD BILL COMP)) { + print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!; + if ($cust_main->payby eq "$_") { + print qq! CHECKED> $paybychecked{$_}</TD>!; + } else { + print qq!> $payby{$_}</TD>!; + } } -print <<END; - - Card number , P.O. # or Authorization <INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo" SIZE=19 MAXLENGTH=19> -END - -print qq!Exp. date (MM/YY or MM/YYYY)<INPUT TYPE="text" NAME="paydate" VALUE="$paydate" SIZE=8 MAXLENGTH=7> Billing name <INPUT TYPE="text" NAME="payname" VALUE="$payname">\n<INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!; -print qq! CHECKED! if $cust_main->tax eq "Y"; -print qq!> Tax Exempt!; - -print <<END; - - -Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker"> -</PRE> +print "</TR></TABLE>$r required fields for each billing type"; + +unless ( $custnum ) { + # pry the wrong place for this logic. also pretty expensive + #use FS::part_pkg; + + #false laziness, copied from FS::cust_pkg::order + my $pkgpart; + if ( scalar(@agents) == 1 ) { + # $pkgpart->{PKGPART} is true iff $custnum may purchase $pkgpart + my($agent)=qsearchs('agent',{'agentnum'=> $agentnum }); + $pkgpart = $agent->pkgpart_hashref; + } else { + #can't know (agent not chosen), so, allow all + my %typenum; + foreach my $agent ( @agents ) { + next if $typenum{$agent->typenum}++; + #fixed in 5.004_05 #$pkgpart->{$_}++ foreach keys %{ $agent->pkgpart_hashref } + foreach ( keys %{ $agent->pkgpart_hashref } ) { $pkgpart->{$_}++; } #5.004_04 workaround + } + } + #eslaf + + my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } } + qsearch( 'part_pkg', {} ); + + if ( @part_pkg ) { + + print "<BR><BR>First package", &itable("#c0c0c0"), + qq!<TR><TD COLSPAN=2><SELECT NAME="pkgpart_svcpart">!; + + print qq!<OPTION VALUE="">(none)!; + + foreach my $part_pkg ( @part_pkg ) { + print qq!<OPTION VALUE="!, +# $part_pkg->pkgpart. "_". $pkgpart{ $part_pkg->pkgpart }, '"'; + $part_pkg->pkgpart. "_". $part_pkg->svcpart, '"'; + print " SELECTED" if $pkgpart && ( $part_pkg->pkgpart == $pkgpart ); + print ">", $part_pkg->pkg, " - ", $part_pkg->comment; + } + print "</SELECT></TD></TR>"; + + #false laziness: (mostly) copied from edit/svc_acct.cgi + #$ulen = $svc_acct->dbdef_table->column('username')->length; + $ulen = dbdef->table('svc_acct')->column('username')->length; + $ulen2 = $ulen+2; + print <<END; +<TR><TD ALIGN="right">Username</TD> +<TD><INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen></TD></TR> +<TR><TD ALIGN="right">Password</TD> +<TD><INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8> +(blank to generate)</TD></TR> END + print qq!<TR><TD ALIGN="right">POP</TD><TD><SELECT NAME="popnum" SIZE=1><OPTION> !; + my($svc_acct_pop); + foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) { + print qq!<OPTION VALUE="!, $svc_acct_pop->popnum, '"', + ( $popnum && $svc_acct_pop->popnum == $popnum ) ? ' SELECTED' : '', ">", + $svc_acct_pop->popnum, ": ", + $svc_acct_pop->city, ", ", + $svc_acct_pop->state, + " (", $svc_acct_pop->ac, ")/", + $svc_acct_pop->exch, "\n" + ; + } + print "</SELECT></TD></TR></TABLE>"; + } +} -print qq!<CENTER><INPUT TYPE="submit" VALUE="!, - $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!; - -print <<END; - - </FORM> - </BODY> -</HTML> -END +$otaker = $cust_main->otaker; +print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!, + qq!<BR><BR><INPUT TYPE="submit" VALUE="!, + $custnum ? "Apply Changes" : "Add Customer", qq!">!, + "</FORM></BODY></HTML>", +; diff --git a/htdocs/edit/cust_main_county-expand.cgi b/htdocs/edit/cust_main_county-expand.cgi index 59ff7043a..783e92826 100755 --- a/htdocs/edit/cust_main_county-expand.cgi +++ b/htdocs/edit/cust_main_county-expand.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county-expand.cgi: Expand a state into counties (output form) +# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -8,39 +8,78 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county-expand.cgi,v $ +# Revision 1.6 1999-01-25 12:09:54 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:35 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:25 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:17:01 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/18 09:01:38 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $taxnum $cust_main_county $p1 $delim $expansion ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -$cgi->var('QUERY_STRING') =~ /^(\d+)$/ - or die "Illegal taxnum!"; -my($taxnum)=$1; +if ( $cgi->param('error') ) { + $taxnum = $cgi->param('taxnum'); + $delim = $cgi->param('delim'); + $expansion = $cgi->param('expansion'); +} else { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/ + or die "Illegal taxnum!"; + $taxnum = $1; + $delim = 'n'; + $expansion = ''; +} -my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}); +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}); die "Can't expand entry!" if $cust_main_county->getfield('county'); -print header("Tax Rate (expand state)", menubar( - 'Main Menu' => '../', -)), <<END; - <FORM ACTION="process/cust_main_county-expand.cgi" METHOD=POST> +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Tax Rate (expand)", menubar( + 'Main Menu' => popurl(2), +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; + <FORM ACTION="${p1}process/cust_main_county-expand.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum"> - Separate counties by - <INPUT TYPE="radio" NAME="delim" VALUE="n" CHECKED>line - (rumor has it broken on some browsers) or - <INPUT TYPE="radio" NAME="delim" VALUE="s">whitespace. + Separate by +END +print '<INPUT TYPE="radio" NAME="delim" VALUE="n"'; +print ' CHECKED' if $delim eq 'n'; +print '>line (rumor has it broken on some browsers) or', + '<INPUT TYPE="radio" NAME="delim" VALUE="s"'; +print ' CHECKED' if $delim eq 's'; +print '>whitespace.'; +print <<END; <BR><INPUT TYPE="submit" VALUE="Submit"> - <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA> + <BR><TEXTAREA NAME="expansion" ROWS=100>$expansion</TEXTAREA> </FORM> </CENTER> </BODY> diff --git a/htdocs/edit/cust_main_county.cgi b/htdocs/edit/cust_main_county.cgi index 904d58346..747a63df6 100755 --- a/htdocs/edit/cust_main_county.cgi +++ b/htdocs/edit/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county.cgi: Edit tax rates (output form) +# $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-13-16 # @@ -9,41 +9,75 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.8 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.7 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.6 1999/01/25 12:09:55 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:36 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:26 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:17:02 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/18 09:01:39 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $cust_main_county ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +print $cgi->header( '-expires' => 'now' ), header("Edit tax rates", menubar( + 'Main Menu' => popurl(2), +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print header("Edit tax rates", menubar( - 'Main Menu' => '../', -)),<<END; - <FORM ACTION="process/cust_main_county.cgi" METHOD=POST> - <TABLE BORDER> +print qq!<FORM ACTION="!, popurl(1), + qq!process/cust_main_county.cgi" METHOD=POST>!, &table(), <<END; <TR> + <TH><FONT SIZE=-1>Country</FONT></TH> <TH><FONT SIZE=-1>State</FONT></TH> <TH>County</TH> <TH><FONT SIZE=-1>Tax</FONT></TH> </TR> END -my($cust_main_county); foreach $cust_main_county ( qsearch('cust_main_county',{}) ) { my($hashref)=$cust_main_county->hashref; print <<END; <TR> - <TD>$hashref->{state}</TD> + <TD>$hashref->{country}</TD> END + print "<TD>", $hashref->{state} + ? $hashref->{state} + : '(ALL)' + , "</TD>"; + print "<TD>", $hashref->{county} ? $hashref->{county} : '(ALL)' diff --git a/htdocs/edit/cust_pay.cgi b/htdocs/edit/cust_pay.cgi index a6cb204d1..5dee76ed9 100755 --- a/htdocs/edit/cust_pay.cgi +++ b/htdocs/edit/cust_pay.cgi @@ -1,61 +1,82 @@ #!/usr/bin/perl -Tw # -# cust_pay.cgi: Add a payment (output form) +# $Id: cust_pay.cgi,v 1.6 1999-02-28 00:03:35 ivan Exp $ # # Usage: cust_pay.cgi invnum # http://server.name/path/cust_pay.cgi?invnum # -# Note: Should be run setuid as user nobody. -# # some hooks for modifications as well as additions, but needs work. # # ivan@voicenet.com 96-dec-11 # # rewrite ivan@sisd.com 98-mar-16 +# +# $Log: cust_pay.cgi,v $ +# Revision 1.6 1999-02-28 00:03:35 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/25 12:09:56 ivan +# yet more mod_perl stuff +# +# Revision 1.4 1999/01/19 05:13:37 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 09:41:27 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:03 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; +use vars qw( $cgi $invnum $p1 $_date $payby $payinfo $paid ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint invnum -$QUERY_STRING =~ /^(\d+)$/; -my($invnum)=$1; +if ( $cgi->param('error') ) { + $invnum = $cgi->param('invnum'); + $paid = $cgi->param('paid'); + $payby = $cgi->param('payby'); + $payinfo = $cgi->param('payinfo'); +} else { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $invnum = $1; + $paid = ''; + $payby = "BILL"; + $payinfo = ""; +} +$_date = time; + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Enter payment", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -SendHeaders(); # one guess. print <<END; -<HTML> - <HEAD> - <TITLE>Enter payment</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Enter payment</H1> - </CENTER> - <FORM ACTION="process/cust_pay.cgi" METHOD=POST> + <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST> <HR><PRE> END -#invnum print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!; -#date -my($date)=time; -print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!; +print qq!<BR>Date: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!; -#paid -print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" SIZE=8 MAXLENGTH=8>!; +print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8>!; -#payby -my($payby)="BILL"; print qq!<BR>Payby: <B>$payby</B><INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!; #payinfo (check # now as payby="BILL" hardcoded.. what to do later?) -my($payinfo)=""; print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!; #paybatch @@ -64,7 +85,7 @@ print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!; print <<END; </PRE> <BR> -<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER> +<INPUT TYPE="submit" VALUE="Post payment"> END print <<END; diff --git a/htdocs/edit/cust_pkg.cgi b/htdocs/edit/cust_pkg.cgi index d7f143db4..b3c92249f 100755 --- a/htdocs/edit/cust_pkg.cgi +++ b/htdocs/edit/cust_pkg.cgi @@ -1,14 +1,12 @@ #!/usr/bin/perl -Tw # -# cust_pkg.cgi: Add/edit packages (output form) +# $Id: cust_pkg.cgi,v 1.8 1999-07-21 07:34:13 ivan Exp $ # # this is for changing packages around, not editing things within the package # # Usage: cust_pkg.cgi custnum # http://server.name/path/cust_pkg.cgi?custnum # -# Note: Should be run setuid freeside as user nobody -# # started with /sales/add/cust_pkg.cgi, which added packages # ivan@voicenet.com 97-jan-5, 97-mar-21 # @@ -23,66 +21,93 @@ # # fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com # 98-jun-1 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.8 1999-07-21 07:34:13 ivan +# links to package browse and agent type edit if there aren't any packages to +# order. thanks to "Tech Account" <techy@orac.hq.org> +# +# Revision 1.7 1999/04/14 01:03:01 ivan +# oops, in 1.2 tree, can't do searches until [cgi|admin]suidsetup, +# bug is hidden by mod_perl persistance +# +# Revision 1.6 1999/02/28 00:03:36 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.3 1999/01/18 09:41:28 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:04 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg + $cust_main $agent $type_pkgs $count %remove_pkg $pkgparts ); +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; +use FS::type_pkgs; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -my(%pkg,%comment); +%pkg = (); +%comment = (); foreach (qsearch('part_pkg', {})) { $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg'); $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment'); } -#untaint custnum -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; +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; +} -my($otaker)=&getotaker; +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''); -SendHeaders(); -print <<END; -<HTML> - <HEAD> - <TITLE>Add/Edit Packages</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Add/Edit Packages</H1> - </CENTER> - <FORM ACTION="process/cust_pkg.cgi" METHOD=POST> - <HR> -END +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) -my(@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) { @@ -90,47 +115,52 @@ 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 -my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); -my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); +$agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); -my($type_pkgs); -my ($count) = 0 ; -print qq!<CENTER><TABLE>! ; +$count = 0; +$pkgparts = 0; +print qq!<TABLE>!; foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + $pkgparts++; my($pkgpart)=$type_pkgs->pkgpart; - print qq!<TR>! if ($count == 0) ; + 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 ++ ; - if ($count == 2) - { + if ( $count == 2 ) { print qq!</TR>\n! ; - $count = 0 ; + $count = 0; } } -print qq!</TABLE></CENTER>! ; +print qq!</TABLE>!; -#otaker -print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!; +unless ( $pkgparts ) { + my $p2 = popurl(2); + my $typenum = $agent->typenum; + my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } ); + my $atype = $agent_type->atype; + print <<END; +(No <a href="${p2}browse/part_pkg.cgi">package definitions</a>, or agent type +<a href="${p2}edit/agent_type.cgi?$typenum">$atype</a> not allowed to purchase +any packages.) +END +} #submit -print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!; - print <<END; +<P><INPUT TYPE="submit" VALUE="Order"> </FORM> </BODY> </HTML> diff --git a/htdocs/edit/part_pkg.cgi b/htdocs/edit/part_pkg.cgi index 9fe739bb7..f7ade88c8 100755 --- a/htdocs/edit/part_pkg.cgi +++ b/htdocs/edit/part_pkg.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $ +# # part_pkg.cgi: Add/Edit package (output form) # # ivan@sisd.com 97-dec-10 @@ -9,37 +11,99 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: part_pkg.cgi,v $ +# 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/; +# +# Revision 1.7 1999/01/18 09:41:29 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.6 1998/12/17 06:17:05 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.5 1998/11/21 07:12:26 ivan +# *** empty log message *** +# +# Revision 1.4 1998/11/21 07:11:08 ivan +# *** empty log message *** +# +# Revision 1.3 1998/11/21 07:07:40 ivan +# popurl, bugfix +# +# Revision 1.2 1998/11/15 13:14:55 ivan +# first pass as per-user custom pricing +# use strict; -use CGI::Base; +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; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +if ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) { + $cgi->param('clone', $1); +} else { + $cgi->param('clone', ''); +} +if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + $cgi->param('pkgnum', $1); +} else { + $cgi->param('pkgnum', ''); +} -my($part_pkg,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1}); - $action='Edit'; -} else { #adding - $part_pkg=create FS::part_pkg {}; - $action='Add'; +($query) = $cgi->keywords; +$action = ''; +$part_pkg = ''; +if ( $cgi->param('error') ) { + $part_pkg = new FS::part_pkg ( { + map { $_, scalar($cgi->param($_)) } fields('part_pkg') + } ); } -my($hashref)=$part_pkg->hashref; +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 && $query =~ /^(\d+)$/ ) { + $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1}); +} else { + $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', +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print header("$action Package Definition", menubar( - 'Main Menu' => '../', - 'View all packages' => '../browse/part_pkg.cgi', -)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>'; +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!">!; +} +if ( $cgi->param('pkgnum') ) { + print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="!, $cgi->param('pkgnum'), qq!">!; +} print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!, "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)"; @@ -54,41 +118,51 @@ Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashr </PRE> +END + +unless ( $cgi->param('clone') ) { + print <<END; Enter the quantity of each service this package includes.<BR><BR> <TABLE BORDER><TR><TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH> <TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH></TR> END +} -my($part_svc); -my($count) = 0 ; -foreach $part_svc ( qsearch('part_svc',{}) ) { - - my($svcpart)=$part_svc->getfield('svcpart'); - my($pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $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, - }) || create 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; - - print qq!<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'), - qq!">!, $part_svc->getfield('svc'), "</A></TD>"; - $count ++ ; - if ($count == 2) - { - print qq!</TR>! ; - $count = 0 ; + #? #next unless $pkg_svc; + + 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="!, + $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++; + if ($count == 2) + { + print '</TR>'; + $count = 0; + } + } else { + print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!, + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!; } } -print qq!</TR>! if ($count != 0) ; -print "</TABLE>"; +unless ( $cgi->param('clone') ) { + print qq!</TR>! if ($count != 0) ; + print "</TABLE>"; +} print qq!<BR><INPUT TYPE="submit" VALUE="!, $hashref->{pkgpart} ? "Apply changes" : "Add package", diff --git a/htdocs/edit/part_referral.cgi b/htdocs/edit/part_referral.cgi index f29802239..24ac9dd82 100755 --- a/htdocs/edit/part_referral.cgi +++ b/htdocs/edit/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: Add/Edit referral (output form) +# $Id: part_referral.cgi,v 1.6 1999-04-07 11:43:23 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -10,40 +10,64 @@ # confisuing typo on submit button ivan@sisd.com 98-jun-14 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# Revision 1.6 1999-04-07 11:43:23 ivan +# pick up errors right away, leave input +# +# 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/; +# +# Revision 1.3 1999/01/18 09:41:30 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:06 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base; +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::Record qw(qsearch qsearchs fields); use FS::part_referral; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($part_referral,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $part_referral=qsearchs('part_referral',{'refnum'=>$1}); - $action='Edit'; +if ( $cgi->param('error') ) { + $part_referral = new FS::part_referral ( { + map { $_, scalar($cgi->param($_)) } fields('part_referral') + } ); +} elsif ( $cgi->keywords ) { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $part_referral = qsearchs( 'part_referral', { 'refnum' => $1 } ); } else { #adding - $part_referral=create FS::part_referral {}; - $action='Add'; + $part_referral = new FS::part_referral {}; } -my($hashref)=$part_referral->hashref; +$action = $part_referral->refnum ? 'Edit' : 'Add'; +$hashref = $part_referral->hashref; -print header("$action Referral", menubar( - 'Main Menu' => '../', - 'View all referrals' => "../browse/part_referral.cgi", -)), <<END; - <FORM ACTION="process/part_referral.cgi" METHOD=POST> -END +$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", +)); + +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 491c013fe..e82306d74 100755 --- a/htdocs/edit/part_svc.cgi +++ b/htdocs/edit/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_svc.cgi: Add/Edit service (output form) +# $Id: part_svc.cgi,v 1.14 2001-05-30 14:42:11 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -8,38 +8,87 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: part_svc.cgi,v $ +# Revision 1.14 2001-05-30 14:42:11 ivan +# Adam Rose <adamr@eaze.net>: "In the /edit/part_svc.cgi is there a need to add +# another section for svc_www?". Yes. Thanks Adam. +# +# Revision 1.13 2000/06/15 11:10:31 ivan +# update to the inline documentation, hopefully will make things more clear +# +# Revision 1.12 1999/04/09 04:22:34 ivan +# also table() +# +# Revision 1.11 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.10 1999/04/08 13:01:50 ivan +# [ AND DOCUMENT! ] all svc_acct services should have a default +# or fixed shell +# +# Revision 1.9 1999/02/23 08:09:21 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# 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/; +# +# Revision 1.6 1999/01/18 09:41:31 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:21 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 06:17:07 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.3 1998/11/21 06:43:26 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $part_svc $action $query $hashref $p %defs $svcdb ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_svc qw(fields); -use FS::CGI qw(header menubar); +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(header menubar popurl table); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($part_svc,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\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=create FS::part_svc {}; - $action='Add'; + $part_svc = new FS::part_svc {}; } -my($hashref)=$part_svc->hashref; +$action = $part_svc->svcpart ? 'Edit' : 'Add'; +$hashref = $part_svc->hashref; -print header("$action Service Definition", menubar( - 'Main Menu' => '../', - 'View all services' => '../browse/part_svc.cgi', -)), '<FORM ACTION="process/part_svc.cgi" METHOD=POST>'; +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar( + 'Main Menu' => $p, + 'View all services' => "${p}browse/part_svc.cgi", +)); +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)"; @@ -47,45 +96,49 @@ print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!, print <<END; <PRE> Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}"> -Table <SELECT NAME="svcdb" SIZE=1> -END - -print map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw( - svc_acct svc_domain svc_acct_sm svc_charge svc_wo -); - -print <<END; -</SELECT></PRE> +</PRE> Services are items you offer to your customers. <UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts <LI>svc_domain - Virtual domains <LI>svc_acct_sm - Virtual domain mail aliasing - <LI>svc_charge - One-time charges (Partially unimplemented) - <LI>svc_wo - Work orders (Partially unimplemented) + <LI>svc_www - Virtual domain website +END +# <LI>svc_charge - One-time charges (Partially unimplemented) +# <LI>svc_wo - Work orders (Partially unimplemented) +print <<END; </UL> -For the columns in the table selected above, you can set default or fixed +For the selected table, you can give fields default or fixed (unchangable) values. For example, a SLIP/PPP account may have a default (or perhaps fixed) <B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or <B>/usr/bin/passwd</B>. <BR><BR> -<TABLE BORDER CELLPADDING=4><TR><TH>Table</TH><TH>Field</TH> +END +print &table(), '<TR><TH>Table<SELECT NAME="svcdb" SIZE=1>', + map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw( + svc_acct svc_domain svc_acct_sm svc_www + ); + print "</SELECT>"; +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo + +print <<END; +</TH><TH>Field</TH> <TH COLSPAN=2>Modifier</TH></TR> END #these might belong somewhere else for other user interfaces #pry need to eventually create stuff that's shared amount UIs -my(%defs)=( +%defs = ( 'svc_acct' => { 'dir' => 'Home directory', 'uid' => 'UID (set to fixed and blank for dial-only)', - 'slipip' => 'IP address', - 'popnum' => '<A HREF="../browse/svc_acct_pop.cgi/">POP number</A>', + 'slipip' => 'IP address (set to fixed and blank to disable dialin)', + 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!, 'username' => 'Username', 'quota' => '(unimplemented)', '_password' => 'Password', 'gid' => 'GID (when blank, defaults to UID)', - 'shell' => 'Shell', + 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)', 'finger' => 'GECOS', }, 'svc_domain' => { @@ -103,11 +156,15 @@ my(%defs)=( 'worker' => 'Worker', '_date' => 'Date', }, + 'svc_www' => { + #'recnum' => '', + #'usersvc' => '', + }, ); -my($svcdb); +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo foreach $svcdb ( qw( - svc_acct svc_domain svc_acct_sm svc_charge svc_wo + svc_acct svc_domain svc_acct_sm svc_www ) ) { my(@rows)=map { /^${svcdb}__(.*)$/; $1 } @@ -119,25 +176,28 @@ foreach $svcdb ( qw( my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>"; my($row); foreach $row (@rows) { - my($value)=$part_svc->getfield($svcdb.'__'.$row); - my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag'); - print "<TR>$ptmp<TD>$row - <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT></TD>"; + my $value = $part_svc->getfield($svcdb. '__'. $row); + my $flag = $part_svc->getfield($svcdb. '__'. $row. '_flag'); + print "<TR>$ptmp<TD>$row"; + print "- <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT>" + if defined $defs{$svcdb}{$row}; + print "</TD>"; print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!. - ' CHECKED'x($flag eq ''). "><BR>Off</TD>"; + ' CHECKED'x($flag eq ''). ">Off</TD>"; print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="D"!. ' CHECKED'x($flag eq 'D'). ">Default "; print qq!<INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="F"!. ' CHECKED'x($flag eq 'F'). ">Fixed "; - print qq!<BR><INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!, - "</TD></TR>"; + print qq!<INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!, + "</TD></TR>\n"; $ptmp=''; } } print "</TABLE>"; -print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!, +print qq!\n<BR><INPUT TYPE="submit" VALUE="!, $hashref->{svcpart} ? "Apply changes" : "Add service", - qq!"></CENTER>!; + qq!">!; print <<END; diff --git a/htdocs/edit/process/agent.cgi b/htdocs/edit/process/agent.cgi index 5d1ce3232..c1b397aac 100755 --- a/htdocs/edit/process/agent.cgi +++ b/htdocs/edit/process/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent.cgi: Edit agent (process form) +# $Id: agent.cgi,v 1.7 1999-01-25 12:09:57 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -8,34 +8,51 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent.cgi,v $ +# Revision 1.7 1999-01-25 12:09:57 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:13:47 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:49 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:26 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:16 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/23 07:52:29 ivan +# *** empty log message *** +# use strict; -use CGI::Request; +use vars qw ( $cgi $agentnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::agent qw(fields); -use FS::CGI qw(idiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearch qsearchs fields); +use FS::agent; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; -my($agentnum)=$req->param('agentnum'); +&cgisuidsetup($cgi); -my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; +$agentnum = $cgi->param('agentnum'); -#unmunge typenum -$req->param('typenum') =~ /^(\d+)(:.*)?$/; -$req->param('typenum',$1); +$old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; -my($new)=create FS::agent ( { +$new = new FS::agent ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('agent') } ); -my($error); if ( $agentnum ) { $error=$new->replace($old); } else { @@ -44,10 +61,9 @@ if ( $agentnum ) { } if ( $error ) { - &idiot($error); + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string ); } else { - #$req->cgi->redirect("../../view/agent.cgi?$agentnum"); - #$req->cgi->redirect("../../edit/agent.cgi?$agentnum"); - $req->cgi->redirect("../../browse/agent.cgi"); + print $cgi->redirect(popurl(3). "browse/agent.cgi"); } diff --git a/htdocs/edit/process/agent_type.cgi b/htdocs/edit/process/agent_type.cgi index 43f129fd5..99c54ab3b 100755 --- a/htdocs/edit/process/agent_type.cgi +++ b/htdocs/edit/process/agent_type.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent_type.cgi: Edit agent type (process form) +# $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $ # # ivan@sisd.com 97-dec-11 # @@ -8,29 +8,51 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent_type.cgi,v $ +# Revision 1.7 1999-01-25 12:09:58 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:13:48 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:50 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:27 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:17 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/21 07:49:20 ivan +# s/CGI::Request/CGI.pm/ +# use strict; -use CGI::Request; +use vars qw ( $cgi $typenum $old $new $error $part_pkg ); +use CGI; use CGI::Carp qw(fatalsToBrowser); +use FS::CGI qw( popurl); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::agent_type qw(fields); +use FS::Record qw(qsearch qsearchs fields); +use FS::agent_type; use FS::type_pkgs; -use FS::CGI qw(idiot); +use FS::part_pkg; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($typenum)=$req->param('typenum'); -my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; +$typenum = $cgi->param('typenum'); +$old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; -my($new)=create FS::agent_type ( { +$new = new FS::agent_type ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('agent_type') } ); -my($error); if ( $typenum ) { $error=$new->replace($old); } else { @@ -39,11 +61,11 @@ if ( $typenum ) { } if ( $error ) { - idiot($error); + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string ); exit; } -my($part_pkg); foreach $part_pkg (qsearch('part_pkg',{})) { my($pkgpart)=$part_pkg->getfield('pkgpart'); @@ -51,33 +73,24 @@ foreach $part_pkg (qsearch('part_pkg',{})) { 'typenum' => $typenum, 'pkgpart' => $pkgpart, }); - if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) { + if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) { my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below. - $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs, - #so ->del not ->delete. hmm. hmm. - if ( $error ) { - idiot($error); - exit; - } + $error=$d_type_pkgs->delete; + die $error if $error; - } elsif ( $req->param("pkgpart$pkgpart") + } elsif ( $cgi->param("pkgpart$pkgpart") && ! $type_pkgs ) { #ok to clobber it now (but bad form nonetheless?) - $type_pkgs=create FS::type_pkgs ({ + $type_pkgs=new FS::type_pkgs ({ 'typenum' => $typenum, 'pkgpart' => $pkgpart, }); $error= $type_pkgs->insert; - if ( $error ) { - idiot($error); - exit; - } + die $error if $error; } } -#$req->cgi->redirect("../../view/agent_type.cgi?$typenum"); -#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum"); -$req->cgi->redirect("../../browse/agent_type.cgi"); +print $cgi->redirect(popurl(3). "browse/agent_type.cgi"); diff --git a/htdocs/edit/process/cust_credit.cgi b/htdocs/edit/process/cust_credit.cgi index e660b4c78..ea9c5a3a2 100755 --- a/htdocs/edit/process/cust_credit.cgi +++ b/htdocs/edit/process/cust_credit.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_credit.cgi: Add a credit (process form) +# $Id: cust_credit.cgi,v 1.7 1999-04-07 15:23:05 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_credit.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-05 -> 96-dec-08 # # post a refund if $new_paybatch @@ -20,51 +18,59 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_credit.cgi,v $ +# Revision 1.7 1999-04-07 15:23:05 ivan +# don't use anchor in redirect +# +# Revision 1.6 1999/02/28 00:03:41 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/25 12:09:59 ivan +# yet more mod_perl stuff +# +# Revision 1.4 1999/01/19 05:13:49 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:47:51 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:18 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $custnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw(popurl); +use FS::Record qw(fields); use FS::cust_credit; -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; -my($custnum)=$1; +$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; +$custnum = $1; -$req->param('otaker',getotaker); +$cgi->param('otaker',getotaker); -my($new) = create FS::cust_credit ( { +$new = new FS::cust_credit ( { map { - $_, $req->param($_); - } qw(custnum _date amount otaker reason) + $_, scalar($cgi->param($_)); + #} qw(custnum _date amount otaker reason) + } fields('cust_credit') } ); -my($error); $error=$new->insert; -&idiot($error) if $error; - -#no errors, no refund, so view our credit. -$req->cgi->redirect("../../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error posting credit/refund</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error posting credit/refund</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 press the <I>Post</I> button again. - </BODY> -</HTML> -END +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); } + diff --git a/htdocs/edit/process/cust_main.cgi b/htdocs/edit/process/cust_main.cgi index 7664dfcb8..25dc0299b 100755 --- a/htdocs/edit/process/cust_main.cgi +++ b/htdocs/edit/process/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_main.cgi: Edit a customer (process form) +# $Id: cust_main.cgi,v 1.11 1999-08-10 12:54:06 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_main.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-04 # # added referral check @@ -20,83 +18,175 @@ # Changes to allow page to work at a relative position in server # Changed 'day' to 'daytime' because Pg6.3 reserves the day word # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_main.cgi,v $ +# Revision 1.11 1999-08-10 12:54:06 ivan +# use FS::cust_pkg::pkgpart_href +# +# Revision 1.10 1999/04/14 07:47:53 ivan +# i18n fixes +# +# Revision 1.9 1999/04/07 15:22:19 ivan +# don't use anchor in redirect +# +# Revision 1.8 1999/03/25 13:55:10 ivan +# one-screen new customer entry (including package and service) for simple +# packages with one svc_acct service +# +# Revision 1.7 1999/02/28 00:03:42 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:10:00 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:50 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:22:32 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.3 1998/12/17 08:40:19 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 08:57:36 ivan +# i18n, s/CGI-modules/CGI.pm/, FS::CGI::idiot instead of inline, FS::CGI::popurl +# use strict; -use CGI::Request; +use vars qw( $cgi $payby @invoicing_list $new $custnum $error ); +use vars qw( $cust_pkg $cust_svc $svc_acct ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw( popurl ); +use FS::Record qw( qsearch qsearchs fields ); use FS::cust_main; +use FS::type_pkgs; +use FS::agent; -my($req)=new CGI::Request; # create form object +$cgi = new CGI; +&cgisuidsetup($cgi); -&cgisuidsetup($req->cgi); +#unmunge stuff -#create new record object +$cgi->param('tax','') unless defined($cgi->param('tax')); + +$cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] ); + +$cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/ + or die "Oops, illegal \"state\" param: ". $cgi->param('state'); +$cgi->param('state', $1); +$cgi->param('county', $3 || ''); +$cgi->param('country', $4); -#unmunge agentnum -$req->param('agentnum', - (split(/:/, ($req->param('agentnum'))[0] ))[0] -); +if ( $payby = $cgi->param('payby') ) { + $cgi->param('payinfo', $cgi->param( $payby. '_payinfo' ) ); + $cgi->param('paydate', + $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' ) ); + $cgi->param('payname', $cgi->param( $payby. '_payname' ) ); +} -#unmunge tax -$req->param('tax','') unless defined($req->param('tax')); +$cgi->param('otaker', &getotaker ); -#unmunge refnum -$req->param('refnum', - (split(/:/, ($req->param('refnum'))[0] ))[0] -); +@invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') ); +push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST'); -#unmunge state/county -$req->param('state') =~ /^(\w+)( \((\w+)\))?$/; -$req->param('state', $1); -$req->param('county', $3 || ''); +#create new record object -my($new) = create FS::cust_main ( { +$new = new FS::cust_main ( { map { - $_, $req->param("$_") || '' - } qw(custnum agentnum last first ss company address1 address2 city county - state zip country daytime night fax payby payinfo paydate payname tax - otaker refnum) + $_, scalar($cgi->param($_)) +# } qw(custnum agentnum last first ss company address1 address2 city county +# state zip daytime night fax payby payinfo paydate payname tax +# otaker refnum) + } fields('cust_main') } ); -if ( $new->custnum eq '' ) { +#perhaps the invocing_list magic should move to cust_main.pm? +$error = $new->check_invoicing_list( \@invoicing_list ); - my($error)=$new->insert; - &idiot($error) if $error; +#perhaps this stuff should go to cust_main.pm as well +$cust_pkg = ''; +$svc_acct = ''; +if ( $new->custnum eq '' ) { + if ( $cgi->param('pkgpart_svcpart') ) { + my $x = $cgi->param('pkgpart_svcpart'); + $x =~ /^(\d+)_(\d+)$/; + my($pkgpart, $svcpart) = ($1, $2); + #false laziness: copied from FS::cust_pkg::order (which should become a + #FS::cust_main method) + my(%part_pkg); + # generate %part_pkg + # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart + my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum }); + #my($type_pkgs); + #foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + # my($pkgpart)=$type_pkgs->pkgpart; + # $part_pkg{$pkgpart}++; + #} + # $pkgpart_href->{PKGPART} is true iff $custnum may purchase $pkgpart + my $pkgpart_href = $agent->pkgpart_hashref; + #eslaf + + # this should wind up in FS::cust_pkg! + $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't". + "purchase pkgpart ". $pkgpart + #unless $part_pkg{ $pkgpart }; + unless $pkgpart_href->{ $pkgpart }; + + $cust_pkg = new FS::cust_pkg ( { + #later 'custnum' => $custnum, + 'pkgpart' => $pkgpart, + } ); + $error ||= $cust_pkg->check; + + #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } ); + + #$error ||= $cust_svc->check; + + $svc_acct = new FS::svc_acct ( { + 'svcpart' => $svcpart, + 'username' => $cgi->param('username'), + '_password' => $cgi->param('_password'), + 'popnum' => $cgi->param('popnum'), + } ); + + my $y = $svc_acct->setdefault; # arguably should be in new method + $error ||= $y unless ref($y); + #and just in case you were silly + $svc_acct->svcpart($svcpart); + $svc_acct->username($cgi->param('username')); + $svc_acct->_password($cgi->param('_password')); + $svc_acct->popnum($cgi->param('popnum')); + + $error ||= $svc_acct->check; + + } elsif ( $cgi->param('username') ) { #good thing to catch + $error = "Can't assign username without a package!"; + } + + $error ||= $new->insert; + if ( $cust_pkg && ! $error ) { + $cust_pkg->custnum( $new->custnum ); + $error ||= $cust_pkg->insert; + warn "WARNING: $error on pre-checked cust_pkg record!" if $error; + $svc_acct->pkgnum( $cust_pkg->pkgnum ); + $error ||= $svc_acct->insert; + warn "WARNING: $error on pre-checked svc_acct record!" if $error; + } } else { #create old record object - - my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } ); - &idiot("Old record not found!") unless $old; - my($error)=$new->replace($old); - &idiot($error) if $error; - -} - -my($custnum)=$new->custnum; -$req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_main"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error updating customer information</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error updating customer information</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 - - exit; - + my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } ); + $error ||= "Old record not found!" unless $old; + $error ||= $new->replace($old); } +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string ); +} else { + $new->invoicing_list( \@invoicing_list ); + $custnum = $new->custnum; + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); +} diff --git a/htdocs/edit/process/cust_main_county-expand.cgi b/htdocs/edit/process/cust_main_county-expand.cgi index a821560c6..a174a0a8e 100755 --- a/htdocs/edit/process/cust_main_county-expand.cgi +++ b/htdocs/edit/process/cust_main_county-expand.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/cust_main_county-expand.cgi: Expand counties (process form) +# $Id: cust_main_county-expand.cgi,v 1.7 2000-12-21 05:22:30 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -12,45 +12,73 @@ # lose background, FS::CGI # undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record # for that state -#ivan@sisd.com 98-sep-2 +# ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county-expand.cgi,v $ +# Revision 1.7 2000-12-21 05:22:30 ivan +# perldoc -f split +# +# Revision 1.6 1999/01/25 12:19:07 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:51 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 22:47:52 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/17 08:40:20 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 09:01:40 ivan +# i18n! i18n! +# use strict; -use CGI::Request; +use vars qw ( $cgi $taxnum $cust_main_county @expansion $expansion ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup datasrc); use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(popurl); use FS::cust_main_county; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::cust_main; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; -my($taxnum)=$1; -my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}) +$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; +$taxnum = $1; +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}) or die ("Unknown taxnum!"); -my(@counties); -if ( $req->param('delim') eq 'n' ) { - @counties=split(/\n/,$req->param('counties')); -} elsif ( $req->param('delim') eq 's' ) { - @counties=split(/\s+/,$req->param('counties')); +if ( $cgi->param('delim') eq 'n' ) { + @expansion=split(/\n/,$cgi->param('expansion')); +} elsif ( $cgi->param('delim') eq 's' ) { + @expansion=split(' ',$cgi->param('expansion')); } else { die "Illegal delim!"; } -@counties=map { - /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county"); +@expansion=map { + unless ( /^\s*([\w\- ]+)\s*$/ ) { + $cgi->param('error', "Illegal item in expansion"); + print $cgi->redirect(popurl(2). "cust_main_county-expand.cgi?". $cgi->query_string ); + exit; + } $1; -} @counties; +} @expansion; -my($county); -foreach ( @counties) { +foreach ( @expansion) { my(%hash)=$cust_main_county->hash; - my($new)=create FS::cust_main_county \%hash; + my($new)=new FS::cust_main_county \%hash; $new->setfield('taxnum',''); - $new->setfield('county',$_); + if ( ! $cust_main_county->state ) { + $new->setfield('state',$_); + } else { + $new->setfield('county',$_); + } #if (datasrc =~ m/Pg/) #{ # $new->setfield('tax',0.0); @@ -62,10 +90,11 @@ foreach ( @counties) { unless ( qsearch('cust_main',{ 'state' => $cust_main_county->getfield('state'), 'county' => $cust_main_county->getfield('county'), + 'country' => $cust_main_county->getfield('country'), } ) ) { my($error)=($cust_main_county->delete); die $error if $error; } -$req->cgi->redirect("../../edit/cust_main_county.cgi"); +print $cgi->redirect(popurl(3). "edit/cust_main_county.cgi"); diff --git a/htdocs/edit/process/cust_main_county.cgi b/htdocs/edit/process/cust_main_county.cgi index 58eaa63ce..0fc1708c5 100755 --- a/htdocs/edit/process/cust_main_county.cgi +++ b/htdocs/edit/process/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent.cgi: Edit cust_main_county (process form) +# $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -8,31 +8,53 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.6 1999-01-25 12:19:08 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:52 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 22:47:53 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/17 08:40:21 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 09:01:41 ivan +# i18n! i18n! +# use strict; -use CGI::Request; +use vars qw( $cgi ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::Record qw(qsearch qsearchs); use FS::cust_main_county; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -foreach ( $req->params ) { +foreach ( $cgi->param ) { /^tax(\d+)$/ or die "Illegal form $_!"; my($taxnum)=$1; my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}) or die "Couldn't find taxnum $taxnum!"; - next unless $old->getfield('tax') ne $req->param("tax$taxnum"); + next unless $old->getfield('tax') ne $cgi->param("tax$taxnum"); my(%hash)=$old->hash; - $hash{tax}=$req->param("tax$taxnum"); - my($new)=create FS::cust_main_county \%hash; + $hash{tax}=$cgi->param("tax$taxnum"); + my($new)=new FS::cust_main_county \%hash; my($error)=$new->replace($old); - eidiot($error) if $error; + if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string ); + exit; + } } -$req->cgi->redirect("../../browse/cust_main_county.cgi"); +print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi"); diff --git a/htdocs/edit/process/cust_pay.cgi b/htdocs/edit/process/cust_pay.cgi index 9ec97532b..ca5029c3c 100755 --- a/htdocs/edit/process/cust_pay.cgi +++ b/htdocs/edit/process/cust_pay.cgi @@ -1,57 +1,67 @@ #!/usr/bin/perl -Tw # -# process/cust_pay.cgi: Add a payment (process form) +# $Id: cust_pay.cgi,v 1.7 1999-02-28 00:03:43 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_pay.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-11 # # rewrite ivan@sisd.com 98-mar-16 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_pay.cgi,v $ +# Revision 1.7 1999-02-28 00:03:43 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:19:09 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:53 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 22:47:54 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:28 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:22 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $invnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::cust_pay qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(fields); +use FS::cust_pay; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($invnum)=$1; +$cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$invnum = $1; -my($new) = create FS::cust_pay ( { +$new = new FS::cust_pay ( { map { - $_, $req->param($_); - } qw(invnum paid _date payby payinfo paybatch) + $_, scalar($cgi->param($_)); + #} qw(invnum paid _date payby payinfo paybatch) + } fields('cust_pay') } ); -my($error); $error=$new->insert; -if ($error) { #error! - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error posting payment</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error posting payment</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 press the <I>Post</I> button again. - </BODY> -</HTML> -END -} else { #no errors! - $req->cgi->redirect("../../view/cust_bill.cgi?$invnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). 'cust_pay.cgi?'. $cgi->query_string ); + exit; +} else { + print $cgi->redirect(popurl(3). "view/cust_bill.cgi?$invnum"); } diff --git a/htdocs/edit/process/cust_pkg.cgi b/htdocs/edit/process/cust_pkg.cgi index 6f5bc875a..9d82b3c24 100755 --- a/htdocs/edit/process/cust_pkg.cgi +++ b/htdocs/edit/process/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/cust_pkg.cgi: Add/edit packages (process form) +# $Id: cust_pkg.cgi,v 1.7 1999-04-07 15:24:06 ivan Exp $ # # this is for changing packages around, not for editing things within the # package @@ -8,8 +8,6 @@ # Usage: post form to: # http://server.name/path/cust_pkg.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 97-mar-21 - 97-mar-24 # # rewrote for new API @@ -19,55 +17,64 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.7 1999-04-07 15:24:06 ivan +# don't use anchor in redirect +# +# Revision 1.6 1999/02/28 00:03:44 ivan +# removed misleading comments +# +# 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 +# also the last s/create/new/; +# +# Revision 1.2 1998/12/17 08:40:23 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +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(popurl); use FS::cust_pkg; -my($req)=new CGI::Request; # create form object - -&cgisuidsetup($req->cgi); +$cgi = new CGI; # create form object +&cgisuidsetup($cgi); +$error = ''; #untaint custnum -$req->param('new_custnum') =~ /^(\d+)$/; -my($custnum)=$1; +$cgi->param('custnum') =~ /^(\d+)$/; +$custnum = $1; -my(@remove_pkgnums) = map { +@remove_pkgnums = map { /^(\d+)$/ or die "Illegal remove_pkg value!"; $1; -} $req->param('remove_pkg'); +} $cgi->param('remove_pkg'); -my(@pkgparts); -my($pkgpart); -foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) { - my($num_pkgs)=$req->param("pkg$pkgpart"); - while ( $num_pkgs-- ) { - push @pkgparts,$pkgpart; +foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) { + if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) { + my $num_pkgs = $1; + while ( $num_pkgs-- ) { + push @pkgparts,$pkgpart; + } + } else { + $error = "Illegal quantity"; + last; } } -my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); +$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); if ($error) { - CGI::Base::SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Error updating packages</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error updating packages</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 + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string ); } else { - $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg"); + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); } diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index 7d787819a..5af9055d6 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: part_pkg.cgi,v 1.9 2001-04-09 23:05:16 ivan Exp $ +# # process/part_pkg.cgi: Edit package definitions (process form) # # ivan@sisd.com 97-dec-10 @@ -13,67 +15,134 @@ # Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_pkg.cgi,v $ +# Revision 1.9 2001-04-09 23:05:16 ivan +# Transactions Part I!!! +# +# 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/; +# +# Revision 1.6 1999/01/18 22:47:56 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.5 1998/12/30 23:03:29 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 08:40:24 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.3 1998/11/21 07:17:58 ivan +# bugfix to work for regular aswell as custom pricing +# +# Revision 1.2 1998/11/15 13:16:15 ivan +# first pass as per-user custom pricing +# use strict; -use CGI::Request; +use vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::part_pkg qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::part_pkg; use FS::pkg_svc; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::cust_pkg; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +$dbh = &cgisuidsetup($cgi); -my($pkgpart)=$req->param('pkgpart'); +$pkgpart = $cgi->param('pkgpart'); -my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; +$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; -my($new)=create FS::part_pkg ( { +$new = new FS::part_pkg ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } 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'; + +local $FS::UID::AutoCommit = 0; + 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 ) { + $dbh->rollback; + $cgi->param('error', $error ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; } -my($part_svc); 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)=$req->param('pkg_svc'. $part_svc->getfield('svcpart')), - my($quantity)=$req->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)=create FS::pkg_svc({ + my $new_pkg_svc = new FS::pkg_svc( { 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - #'quantity' => $req->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); + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } else { - my($error)=$new_pkg_svc->insert; - eidiot($error) if $error; + my $myerror = $new_pkg_svc->insert; + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } } -#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart"); -#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart"); -$req->cgi->redirect("../../browse/part_pkg.cgi"); +unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + $dbh->commit or die $dbh->errstr; + print $cgi->redirect(popurl(3). "browse/part_pkg.cgi"); +} else { + my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } ); + my %hash = $old_cust_pkg->hash; + $hash{'pkgpart'} = $pkgpart; + my($new_cust_pkg) = new FS::cust_pkg \%hash; + my $myerror = $new_cust_pkg->replace($old_cust_pkg); + if ( $myerror ) { + $dbh->rollback; + die "Error modifying cust_pkg record: $myerror\n"; + } + + $dbh->commit or die $dbh->errstr; + 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 08a4c01d0..cde27ede1 100755 --- a/htdocs/edit/process/part_referral.cgi +++ b/htdocs/edit/process/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/part_referral.cgi: Edit referrals (process form) +# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -8,38 +8,58 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# 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/; +# +# Revision 1.4 1999/01/18 22:47:57 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:30 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:25 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $refnum $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_referral qw(fields); -use FS::CGI qw(eidiot); -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearchs fields); +use FS::part_referral; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($refnum)=$req->param('refnum'); +$refnum = $cgi->param('refnum'); -my($new)=create FS::part_referral ( { +$new = new FS::part_referral ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('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'); -$req->cgi->redirect("../../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 0f0fbc6e8..0b3e2cd1c 100755 --- a/htdocs/edit/process/part_svc.cgi +++ b/htdocs/edit/process/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/part_svc.cgi: Edit service definitions (process form) +# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -8,40 +8,62 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_svc.cgi,v $ +# 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/; +# +# Revision 1.5 1999/01/18 22:47:58 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:31 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:26 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/21 06:43:08 ivan +# s/CGI::Request/CGI.pm/ +# use strict; -use CGI::Request; +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); -use FS::part_svc qw(fields); -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($svcpart)=$req->param('svcpart'); +$svcpart = $cgi->param('svcpart'); -my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; +$old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; -my($new)=create FS::part_svc ( { +$new = new FS::part_svc ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); # } qw(svcpart svc svcdb) } fields('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'); } -#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart"); -#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart"); -$req->cgi->redirect("../../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 8d77ba703..84f93abe8 100755 --- a/htdocs/edit/process/svc_acct.cgi +++ b/htdocs/edit/process/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_acct.cgi: Add/edit a customer (process form) +# $Id: svc_acct.cgi,v 1.7 1999-08-27 00:26:33 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi # -# Note: Should br run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-18 # # Changed /u to /u2 @@ -21,67 +19,78 @@ # Changes to allow page to work at a relative position in server # Changed 'password' to '_password' because Pg6.3 reserves the password word # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.7 1999-08-27 00:26:33 ivan +# better error messages +# +# Revision 1.6 1999/02/28 00:03:45 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.3 1999/01/18 22:47:59 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:27 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $old $new $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::Record qw(qsearchs fields); use FS::svc_acct; -my($req) = new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; -my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum; +if ( $svcnum ) { + $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } ) + or die "fatal: can't find account (svcnum $svcnum)!"; +} else { + $old = ''; +} #unmunge popnum -$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] ); +$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] ); #unmunge passwd -if ( $req->param('_password') eq '*HIDDEN*' ) { - $req->param('_password',$old->getfield('_password')); +if ( $cgi->param('_password') eq '*HIDDEN*' ) { + die "fatal: no previous account to recall hidden password from!" unless $old; + $cgi->param('_password',$old->getfield('_password')); } -my($new) = create FS::svc_acct ( { +$new = new FS::svc_acct ( { map { - $_, $req->param($_); - } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir - shell quota slipip) + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir + # shell quota slipip) + } ( fields('svc_acct'), qw( pkgnum svcpart ) ) } ); if ( $svcnum ) { - my($error) = $new->replace($old); - &idiot($error) if $error; + $error = $new->replace($old); } else { - my($error) = $new->insert; - &idiot($error) if $error; - $svcnum = $new->getfield('svcnum'); + $error = $new->insert; + $svcnum = $new->svcnum; } -#no errors, view account -$req->cgi->redirect("../../view/svc_acct.cgi?" . $svcnum ); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error adding/updating account</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error adding/updating account</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 - exit; +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 18d7940b4..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 # -# process/svc_acct_pop.cgi: Edit POP (process form) +# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,36 +8,59 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# 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/; +# +# Revision 1.4 1999/01/18 22:48:00 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:32 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:28 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +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); -use FS::svc_acct_pop qw(fields); -use FS::CGI qw(eidiot); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_pop; +use FS::CGI qw(popurl); -my($req)=new CGI::Request; # create form object +$cgi = new CGI; # create form object -&cgisuidsetup($req->cgi); +&cgisuidsetup($cgi); -my($popnum)=$req->param('popnum'); +$popnum = $cgi->param('popnum'); -my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; +$old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; -my($new)=create FS::svc_acct_pop ( { +$new = new FS::svc_acct_pop ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('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'); } -$req->cgi->redirect("../../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 9ad546bf4..9c39bb8e5 100755 --- a/htdocs/edit/process/svc_acct_sm.cgi +++ b/htdocs/edit/process/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_acct_sm.cgi: Add/edit a mail alias (process form) +# $Id: svc_acct_sm.cgi,v 1.6 1999-02-28 00:03:46 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct_sm.cgi # -# Note: Should br run setuid root as user nobody. -# # lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled. # # ivan@voicenet.com 97-jan-6 @@ -22,33 +20,53 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.6 1999-02-28 00:03:46 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.3 1999/01/18 22:48:01 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:29 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $old $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_acct_sm; +use FS::CGI qw(popurl); -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum =$1; -my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; +$old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; #unmunge domsvc and domuid -$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] ); -$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] ); +#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); +#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); -my($new) = create FS::svc_acct_sm ( { +$new = new FS::svc_acct_sm ( { map { - ($_, scalar($req->param($_))); - } qw(svcnum pkgnum svcpart domuser domuid domsvc) + ($_, scalar($cgi->param($_))); + #} qw(svcnum pkgnum svcpart domuser domuid domsvc) + } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) ) } ); -my($error); if ( $svcnum ) { $error = $new->replace($old); } else { @@ -56,25 +74,10 @@ if ( $svcnum ) { $svcnum = $new->getfield('svcnum'); } -unless ($error) { - $req->cgi->redirect("../../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 { - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error adding/editing mail alias</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error adding/editing mail alias</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 - + 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 0782772dd..ad1892dd1 100755 --- a/htdocs/edit/process/svc_domain.cgi +++ b/htdocs/edit/process/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_domain.cgi: Add a domain (process form) +# $Id: svc_domain.cgi,v 1.7 2001-04-23 07:12:44 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should br run setuid root as user nobody. -# # lots of yucky stuff in this one... bleachlkjhui! # # ivan@voicenet.com 97-jan-6 @@ -18,61 +16,65 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.7 2001-04-23 07:12:44 ivan +# better error message (if kludgy) for no referral +# remove outdated NSI foo from domain ordering. also, fuck NSI. +# +# Revision 1.6 1999/02/28 00:03:47 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.3 1999/01/18 22:48:02 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:30 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +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; -my($req) = new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; -my($new) = create FS::svc_domain ( { +$new = new FS::svc_domain ( { map { - $_, $req->param($_); - } qw(svcnum pkgnum svcpart domain action purpose) + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart domain action purpose) + } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) ) } ); -my($error); -if ($req->param('legal') ne "Yes") { - $error = "Customer did not agree to be bound by NSI's ". - qq!<A HREF="http://rs.internic.net/help/agreement.txt">!. - "Domain Name Resgistration Agreement</A>"; -} elsif ($req->param('svcnum')) { +if ($cgi->param('svcnum')) { $error="Can't modify a domain!"; } else { $error=$new->insert; $svcnum=$new->svcnum; } -unless ($error) { - $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string ); } else { - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error adding domain</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error adding domain</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 - + 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 61d0fdc28..963bc1edf 100755 --- a/htdocs/edit/svc_acct.cgi +++ b/htdocs/edit/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_acct.cgi: Add/edit account (output form) +# $Id: svc_acct.cgi,v 1.10 1999-04-14 11:27:06 ivan Exp $ # # Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 96-dec-18 # # rewrite ivan@sisd.com 98-mar-8 @@ -16,100 +14,139 @@ # bmccane@maxbaud.net 98-apr-3 # # use conf/shells and dbdef username length ivan@sisd.com 98-jul-13 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.10 1999-04-14 11:27:06 ivan +# showpasswords config option to show passwords +# +# Revision 1.9 1999/02/28 00:03:37 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/23 08:09:22 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# 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/; +# +# Revision 1.5 1999/01/18 09:41:32 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 23:03:22 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 06:17:08 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart + $part_svc $svc $otaker $username $password $ulen $ulen2 $p1 + $popnum $uid $gid $finger $dir $shell $quota $slipip ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct qw(fields); - -my($shells)="/var/spool/freeside/conf/shells"; -open(SHELLS,$shells) or die "Can't open $shells: $!"; -my(@shells)=map { - /^([\/\w]*)$/ or die "Illegal shell in conf/shells!"; - $1; -} grep $_ !~ /^#/, <SHELLS>; - -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); - -my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc); +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct; +use FS::Conf; -if ( $QUERY_STRING =~ /^(\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!"; +$cgi = new CGI; +&cgisuidsetup($cgi); - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; +$conf = new FS::Conf; +@shells = $conf->config('shells'); +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"; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; -} else { #adding + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $svc_acct=create FS::svc_acct({}); + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$QUERY_STRING)) { - $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 = new FS::svc_acct({}); - #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') - ) ; - } + 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') + ) ; + } - #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) ); + #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'; - $action="Add"; +$svc = $part_svc->getfield('svc'); -} +$otaker = getotaker; -my($svc)=$part_svc->getfield('svc'); +$username = $svc_acct->username; +if ( $svc_acct->_password ) { + if ( $conf->exists('showpasswords') ) { + $password = $svc_acct->_password; + } else { + $password = "*HIDDEN*"; + } +} else { + $password = ''; +} -my($otaker)=getotaker; +$ulen = $svc_acct->dbdef_table->column('username')->length; +$ulen2 = $ulen+2; -my($username,$password)=( - $svc_acct->username, - $svc_acct->_password ? "*HIDDEN*" : '', -); +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc account"); -my($ulen)=$svc_acct->dbdef_table->column('username')->length; -my($ulen2)=$ulen+2; +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -SendHeaders(); print <<END; -<HTML> - <HEAD> - <TITLE>$action $svc account</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>$action $svc account</H1> - </CENTER><HR> - <FORM ACTION="process/svc_acct.cgi" METHOD=POST> + <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> @@ -121,7 +158,7 @@ Username: END #pop -my($popnum)=$svc_acct->popnum || 0; +$popnum = $svc_acct->popnum || 0; if ( $part_svc->svc_acct__popnum_flag eq "F" ) { print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!; } else { @@ -132,14 +169,14 @@ if ( $part_svc->svc_acct__popnum_flag eq "F" ) { $svc_acct_pop->popnum, ": ", $svc_acct_pop->city, ", ", $svc_acct_pop->state, - "(", $svc_acct_pop->ac, ")/", + " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "\n" ; } print "</SELECT>"; } -my($uid,$gid,$finger,$dir)=( +($uid,$gid,$finger,$dir)=( $svc_acct->uid, $svc_acct->gid, $svc_acct->finger, @@ -153,7 +190,7 @@ print <<END; <INPUT TYPE="hidden" NAME="dir" VALUE="$dir"> END -my($shell)=$svc_acct->shell; +$shell = $svc_acct->shell; if ( $part_svc->svc_acct__shell_flag eq "F" ) { print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!; } else { @@ -166,7 +203,7 @@ if ( $part_svc->svc_acct__shell_flag eq "F" ) { print "</SELECT>"; } -my($quota,$slipip)=( +($quota,$slipip)=( $svc_acct->quota, $svc_acct->slipip, ); @@ -180,7 +217,7 @@ if ( $part_svc->svc_acct__slipip_flag eq "F" ) { } #submit -print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!; +print qq!<P><INPUT TYPE="submit" VALUE="Submit">!; print <<END; </FORM> diff --git a/htdocs/edit/svc_acct_pop.cgi b/htdocs/edit/svc_acct_pop.cgi index 46d803f07..1797b2b8e 100755 --- a/htdocs/edit/svc_acct_pop.cgi +++ b/htdocs/edit/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct_pop.cgi: Add/Edit pop (output form) +# $Id: svc_acct_pop.cgi,v 1.9 2000-01-28 23:02:48 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,38 +8,72 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.9 2000-01-28 23:02:48 ivan +# track full phone number +# +# Revision 1.8 1999/02/23 08:09:23 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# 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/; +# +# Revision 1.5 1999/01/18 09:41:33 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 02:57:45 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:10 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/13 09:56:47 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base; +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::CGI qw(header menubar popurl); use FS::svc_acct_pop; -use FS::CGI qw(header menubar); - -my($cgi) = new CGI::Base; -$cgi->get; - +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($svc_acct_pop,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\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=create FS::svc_acct_pop {}; - $action='Add'; + $svc_acct_pop = new FS::svc_acct_pop {}; } -my($hashref)=$svc_acct_pop->hashref; +$action = $svc_acct_pop->popnum ? 'Edit' : 'Add'; +$hashref = $svc_acct_pop->hashref; -print header("$action POP", menubar( - 'Main Menu' => '../', - 'View all POPs' => "../browse/svc_acct_pop.cgi", -)), <<END; - <FORM ACTION="process/svc_acct_pop.cgi" METHOD=POST> -END +$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", +)); + +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 @@ -49,9 +83,10 @@ 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}"> +Local <INPUT TYPE="text" NAME="loc" SIZE=5 MAXLENGTH=4 VALUE="$hashref->{loc}"> </PRE> END diff --git a/htdocs/edit/svc_acct_sm.cgi b/htdocs/edit/svc_acct_sm.cgi index 45a8eb8fc..cb7cbfae0 100755 --- a/htdocs/edit/svc_acct_sm.cgi +++ b/htdocs/edit/svc_acct_sm.cgi @@ -1,14 +1,12 @@ #!/usr/bin/perl -Tw # -# svc_acct_sm.cgi: Add/edit a mail alias (output form) +# $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:03:38 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} # # use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add # -# Note: Should be run setuid freeside as user nobody. -# # should error out in a more CGI-friendly way, and should have more error checking (sigh). # # ivan@voicenet.com 97-jan-5 @@ -33,71 +31,102 @@ # rewrite ivan@sisd.com 98-mar-15 # # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.9 1999-02-28 00:03:38 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.6 1999/01/18 09:41:34 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:24 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/23 02:58:45 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:11 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/12/16 05:19:15 ivan +# use FS::Conf +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $conf $cgi $mydomain $action $svcnum $svc_acct_sm $pkgnum $svcpart + $part_svc $query %username %domain $p1 $domuser $domsvc $domuid ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct_sm qw(fields); - -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1 -} grep $_ !~ /^(#|$)/, <DOMAIN>; -close DOMAIN; - -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); - -SendHeaders(); # one guess. +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_sm; +use FS::Conf; -my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc); -if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct_sm) svcnum!"; +$cgi = new CGI; +&cgisuidsetup($cgi); - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); - $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=create 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_STRING)) { #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'; -my(%username,%domain); if ($pkgnum) { #find all possible uids (and usernames) @@ -155,17 +184,14 @@ if ($pkgnum) { die "\$action eq Add, but \$pkgnum is null!\n"; } -print <<END; -<HTML> - <HEAD> - <TITLE>Mail Alias $action</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Mail Alias $action</H1> - </CENTER> - <FORM ACTION="process/svc_acct_sm.cgi" METHOD=POST> -END +$p1 = popurl(1); +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 @@ -182,7 +208,7 @@ print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!; #svcpart print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!; -my($domuser,$domsvc,$domuid)=( +($domuser,$domsvc,$domuid)=( $svc_acct_sm->domuser, $svc_acct_sm->domsvc, $svc_acct_sm->domuid, @@ -194,14 +220,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 0717a2c09..49be88073 100755 --- a/htdocs/edit/svc_domain.cgi +++ b/htdocs/edit/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_domain.cgi: Add domain (output form) +# $Id: svc_domain.cgi,v 1.10 2001-04-23 07:12:44 ivan Exp $ # # Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart} # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 97-jan-5 -> 97-jan-6 # # changes for domain template 3.5 @@ -15,92 +13,137 @@ # rewrite ivan@sisd.com 98-mar-14 # # no GOV in instructions ivan@sisd.com 98-jul-17 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.10 2001-04-23 07:12:44 ivan +# better error message (if kludgy) for no referral +# remove outdated NSI foo from domain ordering. also, fuck NSI. +# +# Revision 1.9 1999/02/28 00:03:39 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.6 1999/01/18 09:41:35 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:25 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/23 03:00:16 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:12 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/13 09:56:48 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc + $svc $otaker $domain $p1 $kludge_action $purpose ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); -use FS::svc_domain qw(fields); +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_domain; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc); - -if ( $QUERY_STRING =~ /^(\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=create FS::svc_domain({}); + $svc_domain = new FS::svc_domain({}); - foreach $_ (split(/-/,$QUERY_STRING)) { - $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 = $svcnum ? 'Edit' : 'Add'; - $action="Add"; +$svc = $part_svc->getfield('svc'); -} +$otaker = getotaker; -my($svc)=$part_svc->getfield('svc'); +$domain = $svc_domain->domain; -my($otaker)=getotaker; +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''); -my($domain)=( - $svc_domain->domain, -); +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -SendHeaders(); print <<END; -<HTML> - <HEAD> - <TITLE>$action $svc</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>$action $svc</H1> - </CENTER><HR> - <FORM ACTION="process/svc_domain.cgi" METHOD=POST> + <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 -<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> +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>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 @@ -112,7 +155,8 @@ Domain Name Registration Agreement</A> </UL> US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain and registration procedures. -<P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816). +<!-- <P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816). +!--> </FORM> </BODY> </HTML> |