diff options
Diffstat (limited to 'htdocs/edit')
30 files changed, 3777 insertions, 67 deletions
diff --git a/htdocs/edit/agent.cgi b/htdocs/edit/agent.cgi new file mode 100755 index 000000000..5b42095b3 --- /dev/null +++ b/htdocs/edit/agent.cgi @@ -0,0 +1,108 @@ +#!/usr/bin/perl -Tw +# +# $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $ +# +# ivan@sisd.com 97-dec-12 +# +# Changes to allow page to work at a relative position in server +# Changed 'type' to 'atype' because Pg6.3 reserves the type word +# 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 vars qw ( $cgi $agent $action $hashref $p $agent_type ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header menubar popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::agent; +use FS::agent_type; + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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 = new FS::agent {}; +} +$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 qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +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; +<PRE> +Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}"> +Agent type <SELECT NAME="typenum" SIZE=1> +END + +foreach $agent_type (qsearch('agent_type',{})) { + print "<OPTION VALUE=". $agent_type->typenum; + print " SELECTED" + if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum ); + print ">", $agent_type->getfield('typenum'), ": ", + $agent_type->getfield('atype'),"\n"; +} + +print <<END; +</SELECT> +Frequency (unimplemented) <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}"> +Program (unimplemented) <INPUT TYPE="text" NAME="prog" VALUE="$hashref->{prog}"> +</PRE> +END + +print qq!<BR><INPUT TYPE="submit" VALUE="!, + $hashref->{agentnum} ? "Apply changes" : "Add agent", + qq!">!; + +print <<END; + </FORM> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/agent_type.cgi b/htdocs/edit/agent_type.cgi new file mode 100755 index 000000000..bdf64c58f --- /dev/null +++ b/htdocs/edit/agent_type.cgi @@ -0,0 +1,124 @@ +#!/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 +# +# Changes to allow page to work at a relative position in server +# Changed 'type' to 'atype' because Pg6.3 reserves the type word +# 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 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 fields); +use FS::agent_type; +use FS::CGI qw(header menubar popurl); +use FS::agent_type; +use FS::part_pkg; +use FS::type_pkgs; + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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}); +} else { #adding + $agent_type = new FS::agent_type {}; +} +$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 qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +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><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 + +foreach $part_pkg ( qsearch('part_pkg',{}) ) { + print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!, + $part_pkg->getfield('pkgpart'), qq!" !, + # ( 'CHECKED 'x scalar( + qsearchs('type_pkgs',{ + 'typenum' => $agent_type->getfield('typenum'), + 'pkgpart' => $part_pkg->getfield('pkgpart'), + }) + ? 'CHECKED ' + : '', + qq!VALUE="ON"> !, + qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart, + '">', $part_pkg->getfield('pkg'), '</A>', + ; +} + +print qq!<BR><INPUT TYPE="submit" VALUE="!, + $hashref->{typenum} ? "Apply changes" : "Add agent type", + qq!">!; + +print <<END; + </FORM> + </BODY> +</HTML> +END + 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 new file mode 100755 index 000000000..9c61c654e --- /dev/null +++ b/htdocs/edit/cust_main.cgi @@ -0,0 +1,516 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# ivan@voicenet.com 96-nov-29 -> 96-dec-04 +# +# Blank custnum for new customer. +# ivan@voicenet.com 96-dec-16 +# +# referral defaults to blank, to force people to pick something +# ivan@voicenet.com 97-jun-4 +# +# rewrote for new API +# ivan@voicenet.com 97-jul-28 +# +# new customer is null, not '#' +# otaker gotten from &getotaker instead of $ENV{REMOTE_USER} +# ivan@sisd.com 97-nov-12 +# +# cgisuidsetup($cgi); +# no need for old_ fields. +# now state+county is a select field (took out PA hack) +# used autoloaded $cust_main->field methods +# ivan@sisd.com 97-dec-17 +# +# fixed quoting problems ivan@sisd.com 98-feb-23 +# +# paydate sql update ivan@sisd.com 98-mar-5 +# +# Changes to allow page to work at a relative position in server +# Changed 'day' to 'daytime' because Pg6.3 reserves the day word +# Added test for paydate in mm-dd-yyyy format for Pg6.3 default format +# 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 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 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; + + #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); + +$conf = new FS::Conf; + +#get record + +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 } ); + $pkgpart = 0; + $username = ''; + $password = ''; + $popnum = 0; +} else { + $custnum=''; + $cust_main = new FS::cust_main ( {} ); + $cust_main->setfield('otaker',&getotaker); + $pkgpart = 0; + $username = ''; + $password = ''; + $popnum = 0; +} +$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>!; + +@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>"; +} + +#referral + +$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',{}); + 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>"; + } +} + + +# contact info + +($last,$first,$ss,$company,$address1,$address2,$city,$zip)=( + $cust_main->last, + $cust_main->first, + $cust_main->ss, + $cust_main->company, + $cust_main->address1, + $cust_main->address2, + $cust_main->city, + $cust_main->zip, +); + +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 +} + +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->country eq $_->country + ); + print ">",$_->state; + print " (",$_->county,")" if $_->county; + print " / ", $_->country; +} +print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!; + +($daytime,$night,$fax)=( + $cust_main->daytime, + $cust_main->night, + $cust_main->fax, +); + +print <<END; +<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 + +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"; + } + } + + 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>"; + + $return; +} + +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, +); + +%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 "</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>"; + } +} + +$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 new file mode 100755 index 000000000..783e92826 --- /dev/null +++ b/htdocs/edit/cust_main_county-expand.cgi @@ -0,0 +1,88 @@ +#!/usr/bin/perl -Tw +# +# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $ +# +# ivan@sisd.com 97-dec-16 +# +# Changes to allow page to work at a relative position in server +# 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 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 popurl); +use FS::cust_main_county; + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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 = ''; +} + +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}); +die "Can't expand entry!" if $cust_main_county->getfield('county'); + +$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 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="expansion" ROWS=100>$expansion</TEXTAREA> + </FORM> + </CENTER> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/cust_main_county.cgi b/htdocs/edit/cust_main_county.cgi new file mode 100755 index 000000000..747a63df6 --- /dev/null +++ b/htdocs/edit/cust_main_county.cgi @@ -0,0 +1,100 @@ +#!/usr/bin/perl -Tw +# +# $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ +# +# ivan@sisd.com 97-dec-13-16 +# +# Changes to allow page to work at a relative position in server +# Changed tax field to accept 6 chars (MO uses 6.1%) +# 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 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 popurl table); +use FS::cust_main_county; + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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 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 + +foreach $cust_main_county ( qsearch('cust_main_county',{}) ) { + my($hashref)=$cust_main_county->hashref; + print <<END; + <TR> + <TD>$hashref->{country}</TD> +END + + print "<TD>", $hashref->{state} + ? $hashref->{state} + : '(ALL)' + , "</TD>"; + + print "<TD>", $hashref->{county} + ? $hashref->{county} + : '(ALL)' + , "</TD>"; + + print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum}, + qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD></TR>!; +END + +} + +print <<END; + </TABLE> + <INPUT TYPE="submit" VALUE="Apply changes"> + </FORM> + </CENTER> + </BODY> +</HTML> +END + 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 new file mode 100755 index 000000000..b3c92249f --- /dev/null +++ b/htdocs/edit/cust_pkg.cgi @@ -0,0 +1,167 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# started with /sales/add/cust_pkg.cgi, which added packages +# ivan@voicenet.com 97-jan-5, 97-mar-21 +# +# Rewrote for new API +# ivan@voicenet.com 97-jul-7 +# +# FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7 +# +# Changes to allow page to work at a relative position in server +# Changed to display packages 2-wide in a table +# bmccane@maxbaud.net 98-apr-3 +# +# 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 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); +use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(header popurl); +use FS::part_pkg; +use FS::type_pkgs; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +%pkg = (); +%comment = (); +foreach (qsearch('part_pkg', {})) { + $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg'); + $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment'); +} + +if ( $cgi->param('error') ) { + $custnum = $cgi->param('custnum'); + %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg'); +} else { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + undef %remove_pkg; +} + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!; + +print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; + +#current packages +@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } ); + +if (@cust_pkg) { + print <<END; +Current packages - select to remove (services are moved to a new package below) +<BR><BR> +END + + my ($count) = 0 ; + print qq!<TABLE>! ; + foreach (@cust_pkg) { + print '<TR>' if $count == 0; + my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') ); + 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) + { + $count = 0 ; + print qq!</TR>\n! ; + } + } + print qq!</TABLE><BR><BR>!; +} + +print <<END; +Order new packages<BR><BR> +END + +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); +$agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); + +$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 ); + my $value = $cgi->param("pkg$pkgpart") || 0; + print <<END; + <TD> + <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2"> + $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n +END + $count ++ ; + if ( $count == 2 ) { + print qq!</TR>\n! ; + $count = 0; + } +} +print qq!</TABLE>!; + +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 <<END; +<P><INPUT TYPE="submit" VALUE="Order"> + </FORM> + </BODY> +</HTML> +END diff --git a/htdocs/edit/part_pkg.cgi b/htdocs/edit/part_pkg.cgi new file mode 100755 index 000000000..f7ade88c8 --- /dev/null +++ b/htdocs/edit/part_pkg.cgi @@ -0,0 +1,176 @@ +#!/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 +# +# Changes to allow page to work at a relative position in server +# Changed to display services 2-wide in table +# 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 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 fields); +use FS::part_pkg; +use FS::part_svc; +use FS::pkg_svc; +use FS::CGI qw(header menubar popurl); + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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', ''); +} + +($query) = $cgi->keywords; +$action = ''; +$part_pkg = ''; +if ( $cgi->param('error') ) { + $part_pkg = new FS::part_pkg ( { + map { $_, scalar($cgi->param($_)) } fields('part_pkg') + } ); +} +if ( $cgi->param('clone') ) { + $action='Custom Pricing'; + my $old_part_pkg = + qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } ); + $part_pkg ||= $old_part_pkg->clone; +} elsif ( $query && $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 '<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)"; + +print <<END; +<PRE> +Package (customer-visable) <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}"> +Comment (customer-hidden) <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}"> +Setup fee for this package <INPUT TYPE="text" NAME="setup" VALUE="$hashref->{setup}"> +Recurring fee for this package <INPUT TYPE="text" NAME="recur" VALUE="$hashref->{recur}"> +Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}"> + +</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 +} + +$count = 0; +foreach $part_svc ( ( qsearch( 'part_svc', {} ) ) ) { + my $svcpart = $part_svc->svcpart; + my $pkg_svc = qsearchs( 'pkg_svc', { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, + 'svcpart' => $svcpart, + } ) || new FS::pkg_svc ( { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, + 'svcpart' => $svcpart, + 'quantity' => 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!; + } +} + +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", + qq!">!; + +print <<END; + </FORM> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/part_referral.cgi b/htdocs/edit/part_referral.cgi new file mode 100755 index 000000000..24ac9dd82 --- /dev/null +++ b/htdocs/edit/part_referral.cgi @@ -0,0 +1,90 @@ +#!/usr/bin/perl -Tw +# +# $Id: part_referral.cgi,v 1.6 1999-04-07 11:43:23 ivan Exp $ +# +# ivan@sisd.com 98-feb-23 +# +# Changes to allow page to work at a relative position in server +# bmccane@maxbaud.net 98-apr-3 +# +# 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 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 fields); +use FS::part_referral; +use FS::CGI qw(header menubar popurl); + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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 = new FS::part_referral {}; +} +$action = $part_referral->refnum ? 'Edit' : 'Add'; +$hashref = $part_referral->hashref; + +$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'); + +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)"; + +print <<END; +<PRE> +Referral <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}"> +</PRE> +END + +print qq!<BR><INPUT TYPE="submit" VALUE="!, + $hashref->{refnum} ? "Apply changes" : "Add referral", + qq!">!; + +print <<END; + </FORM> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/part_svc.cgi b/htdocs/edit/part_svc.cgi new file mode 100755 index 000000000..e82306d74 --- /dev/null +++ b/htdocs/edit/part_svc.cgi @@ -0,0 +1,208 @@ +#!/usr/bin/perl -Tw +# +# $Id: part_svc.cgi,v 1.14 2001-05-30 14:42:11 ivan Exp $ +# +# ivan@sisd.com 97-nov-14 +# +# Changes to allow page to work at a relative position in server +# 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 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 fields); +use FS::part_svc; +use FS::CGI qw(header menubar popurl table); + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +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}); +} else { #adding + $part_svc = new FS::part_svc {}; +} +$action = $part_svc->svcpart ? 'Edit' : 'Add'; +$hashref = $part_svc->hashref; + +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar( + 'Main Menu' => $p, + 'View all services' => "${p}browse/part_svc.cgi", +)); + +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)"; + +print <<END; +<PRE> +Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}"> +</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_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 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> +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 +%defs = ( + 'svc_acct' => { + 'dir' => 'Home directory', + 'uid' => 'UID (set to fixed and blank for dial-only)', + '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 (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)', + 'finger' => 'GECOS', + }, + 'svc_domain' => { + 'domain' => 'Domain', + }, + 'svc_acct_sm' => { + 'domuser' => 'domuser@virtualdomain.com', + 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded', + 'domsvc' => 'svcnum from svc_domain for virtualdomain.com', + }, + 'svc_charge' => { + 'amount' => 'amount', + }, + 'svc_wo' => { + 'worker' => 'Worker', + '_date' => 'Date', + }, + 'svc_www' => { + #'recnum' => '', + #'usersvc' => '', + }, +); + +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo +foreach $svcdb ( qw( + svc_acct svc_domain svc_acct_sm svc_www +) ) { + + my(@rows)=map { /^${svcdb}__(.*)$/; $1 } + grep ! /_flag$/, + grep /^${svcdb}__/, + fields('part_svc'); + my($rowspan)=scalar(@rows); + + 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"; + 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 ''). ">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!<INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!, + "</TD></TR>\n"; + $ptmp=''; + } +} +print "</TABLE>"; + +print qq!\n<BR><INPUT TYPE="submit" VALUE="!, + $hashref->{svcpart} ? "Apply changes" : "Add service", + qq!">!; + +print <<END; + + </FORM> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/process/agent.cgi b/htdocs/edit/process/agent.cgi new file mode 100755 index 000000000..c1b397aac --- /dev/null +++ b/htdocs/edit/process/agent.cgi @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw +# +# $Id: agent.cgi,v 1.7 1999-01-25 12:09:57 ivan Exp $ +# +# ivan@sisd.com 97-dec-12 +# +# Changes to allow page to work at a relative position in server +# 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 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 fields); +use FS::agent; +use FS::CGI qw(popurl); + +$cgi = new CGI; + +&cgisuidsetup($cgi); + +$agentnum = $cgi->param('agentnum'); + +$old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; + +$new = new FS::agent ( { + map { + $_, scalar($cgi->param($_)); + } fields('agent') +} ); + +if ( $agentnum ) { + $error=$new->replace($old); +} else { + $error=$new->insert; + $agentnum=$new->getfield('agentnum'); +} + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/agent.cgi"); +} + diff --git a/htdocs/edit/process/agent_type.cgi b/htdocs/edit/process/agent_type.cgi new file mode 100755 index 000000000..99c54ab3b --- /dev/null +++ b/htdocs/edit/process/agent_type.cgi @@ -0,0 +1,96 @@ +#!/usr/bin/perl -Tw +# +# $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $ +# +# ivan@sisd.com 97-dec-11 +# +# Changes to allow page to work at a relative position in server +# 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 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 fields); +use FS::agent_type; +use FS::type_pkgs; +use FS::part_pkg; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$typenum = $cgi->param('typenum'); +$old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; + +$new = new FS::agent_type ( { + map { + $_, scalar($cgi->param($_)); + } fields('agent_type') +} ); + +if ( $typenum ) { + $error=$new->replace($old); +} else { + $error=$new->insert; + $typenum=$new->getfield('typenum'); +} + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string ); + exit; +} + +foreach $part_pkg (qsearch('part_pkg',{})) { + my($pkgpart)=$part_pkg->getfield('pkgpart'); + + my($type_pkgs)=qsearchs('type_pkgs',{ + 'typenum' => $typenum, + '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->delete; + die $error if $error; + + } elsif ( $cgi->param("pkgpart$pkgpart") + && ! $type_pkgs + ) { + #ok to clobber it now (but bad form nonetheless?) + $type_pkgs=new FS::type_pkgs ({ + 'typenum' => $typenum, + 'pkgpart' => $pkgpart, + }); + $error= $type_pkgs->insert; + die $error if $error; + } + +} + +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 new file mode 100755 index 000000000..ea9c5a3a2 --- /dev/null +++ b/htdocs/edit/process/cust_credit.cgi @@ -0,0 +1,76 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# ivan@voicenet.com 96-dec-05 -> 96-dec-08 +# +# post a refund if $new_paybatch +# ivan@voicenet.com 96-dec-08 +# +# refunds are no longer applied against a specific payment (paybatch) +# paybatch field removed +# ivan@voicenet.com 97-apr-22 +# +# 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_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 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; + +$cgi = new CGI; +cgisuidsetup($cgi); + +$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; +$custnum = $1; + +$cgi->param('otaker',getotaker); + +$new = new FS::cust_credit ( { + map { + $_, scalar($cgi->param($_)); + #} qw(custnum _date amount otaker reason) + } fields('cust_credit') +} ); + +$error=$new->insert; + +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 new file mode 100755 index 000000000..25dc0299b --- /dev/null +++ b/htdocs/edit/process/cust_main.cgi @@ -0,0 +1,192 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# ivan@voicenet.com 96-dec-04 +# +# added referral check +# ivan@voicenet.com 97-jun-4 +# +# rewrote for new API +# ivan@voicenet.com 97-jul-28 +# +# same as above (again) and clean up some stuff ivan@sisd.com 98-feb-23 +# +# 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 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 getotaker); +use FS::CGI qw( popurl ); +use FS::Record qw( qsearch qsearchs fields ); +use FS::cust_main; +use FS::type_pkgs; +use FS::agent; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +#unmunge stuff + +$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); + +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' ) ); +} + +$cgi->param('otaker', &getotaker ); + +@invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') ); +push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST'); + +#create new record object + +$new = new FS::cust_main ( { + map { + $_, 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') +} ); + +#perhaps the invocing_list magic should move to cust_main.pm? +$error = $new->check_invoicing_list( \@invoicing_list ); + +#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 } ); + $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 new file mode 100755 index 000000000..a174a0a8e --- /dev/null +++ b/htdocs/edit/process/cust_main_county-expand.cgi @@ -0,0 +1,100 @@ +#!/usr/bin/perl -Tw +# +# $Id: cust_main_county-expand.cgi,v 1.7 2000-12-21 05:22:30 ivan Exp $ +# +# ivan@sisd.com 97-dec-16 +# +# Changes to allow page to work at a relative position in server +# Added import of datasrc from UID.pm for Pg6.3 +# Default tax to 0.0 if using Pg6.3 +# bmccane@maxbaud.net 98-apr-3 +# +# 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 +# +# $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 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::cust_main; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; +$taxnum = $1; +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}) + or die ("Unknown taxnum!"); + +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!"; +} + +@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; +} @expansion; + +foreach ( @expansion) { + my(%hash)=$cust_main_county->hash; + my($new)=new FS::cust_main_county \%hash; + $new->setfield('taxnum',''); + if ( ! $cust_main_county->state ) { + $new->setfield('state',$_); + } else { + $new->setfield('county',$_); + } + #if (datasrc =~ m/Pg/) + #{ + # $new->setfield('tax',0.0); + #} + my($error)=$new->insert; + die $error if $error; +} + +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; +} + +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 new file mode 100755 index 000000000..0fc1708c5 --- /dev/null +++ b/htdocs/edit/process/cust_main_county.cgi @@ -0,0 +1,60 @@ +#!/usr/bin/perl -Tw +# +# $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $ +# +# ivan@sisd.com 97-dec-16 +# +# Changes to allow page to work at a relative position in server +# 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 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; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +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 $cgi->param("tax$taxnum"); + my(%hash)=$old->hash; + $hash{tax}=$cgi->param("tax$taxnum"); + my($new)=new FS::cust_main_county \%hash; + my($error)=$new->replace($old); + if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string ); + exit; + } +} + +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 new file mode 100755 index 000000000..ca5029c3c --- /dev/null +++ b/htdocs/edit/process/cust_pay.cgi @@ -0,0 +1,67 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# 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 vars qw( $cgi $invnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); +use FS::Record qw(fields); +use FS::cust_pay; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$invnum = $1; + +$new = new FS::cust_pay ( { + map { + $_, scalar($cgi->param($_)); + #} qw(invnum paid _date payby payinfo paybatch) + } fields('cust_pay') +} ); + +$error=$new->insert; + +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 new file mode 100755 index 000000000..9d82b3c24 --- /dev/null +++ b/htdocs/edit/process/cust_pkg.cgi @@ -0,0 +1,80 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# Usage: post form to: +# http://server.name/path/cust_pkg.cgi +# +# ivan@voicenet.com 97-mar-21 - 97-mar-24 +# +# rewrote for new API +# ivan@voicenet.com 97-jul-7 - 15 +# +# &cgisuidsetup($cgi) ivan@sisd.com 98-mar-7 +# +# 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 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; + +$cgi = new CGI; # create form object +&cgisuidsetup($cgi); +$error = ''; + +#untaint custnum +$cgi->param('custnum') =~ /^(\d+)$/; +$custnum = $1; + +@remove_pkgnums = map { + /^(\d+)$/ or die "Illegal remove_pkg value!"; + $1; +} $cgi->param('remove_pkg'); + +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; + } +} + +$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); + +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string ); +} else { + 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 new file mode 100755 index 000000000..5af9055d6 --- /dev/null +++ b/htdocs/edit/process/part_pkg.cgi @@ -0,0 +1,148 @@ +#!/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 +# +# don't update non-changing records in part_svc (causing harmless but annoying +# "Records identical" errors). ivan@sisd.com 98-feb-19 +# +# Changes to allow page to work at a relative position in server +# bmccane@maxbaud.net 98-apr-3 +# +# 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 vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::part_pkg; +use FS::pkg_svc; +use FS::cust_pkg; + +$cgi = new CGI; +$dbh = &cgisuidsetup($cgi); + +$pkgpart = $cgi->param('pkgpart'); + +$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; + +$new = new FS::part_pkg ( { + map { + $_, 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 ) { + $error = $new->replace($old); +} else { + $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; +} + +foreach $part_svc (qsearch('part_svc',{})) { + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; + next unless $old_quantity != $quantity; #!here + my $new_pkg_svc = new FS::pkg_svc( { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + 'quantity' => $quantity, + } ); + if ( $old_pkg_svc ) { + my $myerror = $new_pkg_svc->replace($old_pkg_svc); + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } + } else { + my $myerror = $new_pkg_svc->insert; + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } + } +} + +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 new file mode 100755 index 000000000..cde27ede1 --- /dev/null +++ b/htdocs/edit/process/part_referral.cgi @@ -0,0 +1,65 @@ +#!/usr/bin/perl -Tw +# +# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $ +# +# ivan@sisd.com 98-feb-23 +# +# Changes to allow page to work at a relative position in server +# 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 vars qw( $cgi $refnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearchs fields); +use FS::part_referral; +use FS::CGI qw(popurl); + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$refnum = $cgi->param('refnum'); + +$new = new FS::part_referral ( { + map { + $_, scalar($cgi->param($_)); + } fields('part_referral') +} ); + +if ( $refnum ) { + my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } ); + die "(Old) Record not found!" unless $old; + $error = $new->replace($old); +} else { + $error = $new->insert; +} +$refnum=$new->refnum; + +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 new file mode 100755 index 000000000..0b3e2cd1c --- /dev/null +++ b/htdocs/edit/process/part_svc.cgi @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw +# +# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $ +# +# ivan@sisd.com 97-nov-14 +# +# Changes to allow page to work at a relative position in server +# 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 vars qw ( $cgi $svcpart $old $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(popurl); + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$svcpart = $cgi->param('svcpart'); + +$old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; + +$new = new FS::part_svc ( { + map { + $_, scalar($cgi->param($_)); +# } qw(svcpart svc svcdb) + } fields('part_svc') +} ); + +if ( $svcpart ) { + $error = $new->replace($old); +} else { + $error = $new->insert; + $svcpart=$new->getfield('svcpart'); +} + +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 new file mode 100755 index 000000000..84f93abe8 --- /dev/null +++ b/htdocs/edit/process/svc_acct.cgi @@ -0,0 +1,96 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# ivan@voicenet.com 96-dec-18 +# +# Changed /u to /u2 +# ivan@voicenet.com 97-may-6 +# +# rewrote for new API +# ivan@voicenet.com 97-jul-17 - 21 +# +# no FS::Search, FS::svc_acct creates FS::cust_svc record, used for adding +# and editing ivan@sisd.com 98-mar-8 +# +# 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 vars qw( $cgi $svcnum $old $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); +use FS::Record qw(qsearchs fields); +use FS::svc_acct; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; + +if ( $svcnum ) { + $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } ) + or die "fatal: can't find account (svcnum $svcnum)!"; +} else { + $old = ''; +} + +#unmunge popnum +$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] ); + +#unmunge passwd +if ( $cgi->param('_password') eq '*HIDDEN*' ) { + die "fatal: no previous account to recall hidden password from!" unless $old; + $cgi->param('_password',$old->getfield('_password')); +} + +$new = new FS::svc_acct ( { + map { + $_, 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 ) { + $error = $new->replace($old); +} else { + $error = $new->insert; + $svcnum = $new->svcnum; +} + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); +} + diff --git a/htdocs/edit/process/svc_acct_pop.cgi b/htdocs/edit/process/svc_acct_pop.cgi new file mode 100755 index 000000000..763bca4a8 --- /dev/null +++ b/htdocs/edit/process/svc_acct_pop.cgi @@ -0,0 +1,66 @@ +#!/usr/bin/perl -Tw +# +# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $ +# +# ivan@sisd.com 98-mar-8 +# +# Changes to allow page to work at a relative position in server +# 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 vars qw( $cgi $popnum $old $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_pop; +use FS::CGI qw(popurl); + +$cgi = new CGI; # create form object + +&cgisuidsetup($cgi); + +$popnum = $cgi->param('popnum'); + +$old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; + +$new = new FS::svc_acct_pop ( { + map { + $_, scalar($cgi->param($_)); + } fields('svc_acct_pop') +} ); + +if ( $popnum ) { + $error = $new->replace($old); +} else { + $error = $new->insert; + $popnum=$new->getfield('popnum'); +} + +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 new file mode 100755 index 000000000..9c39bb8e5 --- /dev/null +++ b/htdocs/edit/process/svc_acct_sm.cgi @@ -0,0 +1,83 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled. +# +# ivan@voicenet.com 97-jan-6 +# +# enabled modifications +# +# ivan@voicenet.com 97-may-7 +# +# fixed removal of cust_svc record on modifications! +# ivan@voicenet.com 97-jun-5 +# +# rewrite ivan@sisd.com 98-mar-15 +# +# 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 vars qw( $cgi $svcnum $old $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearchs fields); +use FS::svc_acct_sm; +use FS::CGI qw(popurl); + +$cgi = new CGI; +cgisuidsetup($cgi); + +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum =$1; + +$old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; + +#unmunge domsvc and domuid +#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); +#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); + +$new = new FS::svc_acct_sm ( { + map { + ($_, scalar($cgi->param($_))); + #} qw(svcnum pkgnum svcpart domuser domuid domsvc) + } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) ) +} ); + +if ( $svcnum ) { + $error = $new->replace($old); +} else { + $error = $new->insert; + $svcnum = $new->getfield('svcnum'); +} + +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string ); +} else { + 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 new file mode 100755 index 000000000..ad1892dd1 --- /dev/null +++ b/htdocs/edit/process/svc_domain.cgi @@ -0,0 +1,80 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# lots of yucky stuff in this one... bleachlkjhui! +# +# ivan@voicenet.com 97-jan-6 +# +# kludged for new domain template 3.5 +# ivan@voicenet.com 97-jul-24 +# +# moved internic bits to svc_domain.pm ivan@sisd.com 98-mar-14 +# +# 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 vars qw( $cgi $svcnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +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; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; + +$new = new FS::svc_domain ( { + map { + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart domain action purpose) + } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) ) +} ); + +if ($cgi->param('svcnum')) { + $error="Can't modify a domain!"; +} else { + $error=$new->insert; + $svcnum=$new->svcnum; +} + +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); +} + diff --git a/htdocs/edit/svc_acct.cgi b/htdocs/edit/svc_acct.cgi new file mode 100755 index 000000000..963bc1edf --- /dev/null +++ b/htdocs/edit/svc_acct.cgi @@ -0,0 +1,228 @@ +#!/usr/bin/perl -Tw +# +# $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} +# +# ivan@voicenet.com 96-dec-18 +# +# rewrite ivan@sisd.com 98-mar-8 +# +# 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 +# +# 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 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::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct; +use FS::Conf; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$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!"; + + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; + + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + } else { #adding + + $svc_acct = new FS::svc_acct({}); + + 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) ); + } + } + + } +} +$action = $svcnum ? 'Edit' : 'Add'; + +$svc = $part_svc->getfield('svc'); + +$otaker = getotaker; + +$username = $svc_acct->username; +if ( $svc_acct->_password ) { + if ( $conf->exists('showpasswords') ) { + $password = $svc_acct->_password; + } else { + $password = "*HIDDEN*"; + } +} else { + $password = ''; +} + +$ulen = $svc_acct->dbdef_table->column('username')->length; +$ulen2 = $ulen+2; + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc account"); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; + <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST> + <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> + <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> + <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> +Username: +<INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen> +<BR>Password: +<INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8> +(blank to generate) +END + +#pop +$popnum = $svc_acct->popnum || 0; +if ( $part_svc->svc_acct__popnum_flag eq "F" ) { + print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!; +} else { + print qq!<BR>POP: <SELECT NAME="popnum" SIZE=1><OPTION>\n!; + my($svc_acct_pop); + foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) { + print "<OPTION", $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>"; +} + +($uid,$gid,$finger,$dir)=( + $svc_acct->uid, + $svc_acct->gid, + $svc_acct->finger, + $svc_acct->dir, +); + +print <<END; +<INPUT TYPE="hidden" NAME="uid" VALUE="$uid"> +<INPUT TYPE="hidden" NAME="gid" VALUE="$gid"> +<BR>GECOS: <INPUT TYPE="text" NAME="finger" VALUE="$finger"> +<INPUT TYPE="hidden" NAME="dir" VALUE="$dir"> +END + +$shell = $svc_acct->shell; +if ( $part_svc->svc_acct__shell_flag eq "F" ) { + print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!; +} else { + print qq!<BR>Shell: <SELECT NAME="shell" SIZE=1>!; + my($etc_shell); + foreach $etc_shell (@shells) { + print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">", + $etc_shell, "\n"; + } + print "</SELECT>"; +} + +($quota,$slipip)=( + $svc_acct->quota, + $svc_acct->slipip, +); + +print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!; + +if ( $part_svc->svc_acct__slipip_flag eq "F" ) { + print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!; +} else { + print qq!<BR>IP: <INPUT TYPE="text" NAME="slipip" VALUE="$slipip">!; +} + +#submit +print qq!<P><INPUT TYPE="submit" VALUE="Submit">!; + +print <<END; + </FORM> + </BODY> +</HTML> +END + + diff --git a/htdocs/edit/svc_acct_pop.cgi b/htdocs/edit/svc_acct_pop.cgi new file mode 100755 index 000000000..1797b2b8e --- /dev/null +++ b/htdocs/edit/svc_acct_pop.cgi @@ -0,0 +1,102 @@ +#!/usr/bin/perl -Tw +# +# $Id: svc_acct_pop.cgi,v 1.9 2000-01-28 23:02:48 ivan Exp $ +# +# ivan@sisd.com 98-mar-8 +# +# Changes to allow page to work at a relative position in server +# 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 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 fields); +use FS::CGI qw(header menubar popurl); +use FS::svc_acct_pop; +$cgi = new CGI; +&cgisuidsetup($cgi); + +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}); +} else { #adding + $svc_acct_pop = new FS::svc_acct_pop {}; +} +$action = $svc_acct_pop->popnum ? 'Edit' : 'Add'; +$hashref = $svc_acct_pop->hashref; + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar( + 'Main Menu' => popurl(2), + 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi", +)); + +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 + +print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!, + "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)"; + +print <<END; +<PRE> +City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}"> +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 + +print qq!<BR><INPUT TYPE="submit" VALUE="!, + $hashref->{popnum} ? "Apply changes" : "Add POP", + qq!">!; + +print <<END; + </FORM> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/svc_acct_sm.cgi b/htdocs/edit/svc_acct_sm.cgi new file mode 100755 index 000000000..cb7cbfae0 --- /dev/null +++ b/htdocs/edit/svc_acct_sm.cgi @@ -0,0 +1,247 @@ +#!/usr/bin/perl -Tw +# +# $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 +# +# should error out in a more CGI-friendly way, and should have more error checking (sigh). +# +# ivan@voicenet.com 97-jan-5 +# +# added debugging code; fixed CPU-sucking problem with trying to edit an (unaudited) mail alias (no pkgnum) +# +# ivan@voicenet.com 97-may-7 +# +# fixed uid selection +# ivan@voicenet.com 97-jun-4 +# +# uid selection across _CUSTOMER_, not just _PACKAGE_ +# +# ( i need to be rewritten with fast searches) +# +# ivan@voicenet.com 97-oct-3 +# +# added fast searches in some of the places where it is sorely needed... +# I see DBI::mysql in your future... +# ivan@voicenet.com 97-oct-23 +# +# 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 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::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_sm; +use FS::Conf; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); + +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!"; + + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; + + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + } else { #adding + + $svc_acct_sm = new FS::svc_acct_sm({}); + + 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; + + $svcnum=''; + + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct_sm') ) { + if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { + $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + } + } + + } +} +$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add'; + +if ($pkgnum) { + + #find all possible uids (and usernames) + + my($u_part_svc,@u_acct_svcparts); + foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) { + push @u_acct_svcparts,$u_part_svc->getfield('svcpart'); + } + + my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); + my($custnum)=$cust_pkg->getfield('custnum'); + my($i_cust_pkg); + foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) { + my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum'); + my($acct_svcpart); + foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding + #record(s) in cust_svc ( for this + #pkgnum ! ) + my($i_cust_svc); + foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) { + my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')}); + $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username'); + } + } + } + + #find all possible domains (and domsvc's) + + my($d_part_svc,@d_acct_svcparts); + foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) { + push @d_acct_svcparts,$d_part_svc->getfield('svcpart'); + } + + foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) { + my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum'); + my($acct_svcpart); + foreach $acct_svcpart (@d_acct_svcparts) { + my($i_cust_svc); + foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) { + my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')}); + $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain'); + } + } + } + +} elsif ( $action eq 'Edit' ) { + + my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid}); + $username{$svc_acct_sm->uid} = $svc_acct->username; + + my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc}); + $domain{$svc_acct_sm->domsvc} = $svc_domain->domain; + +} else { + die "\$action eq Add, but \$pkgnum is null!\n"; +} + +$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 + + #formatting + print "<PRE>"; + +#svcnum +print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!; +print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>"; + +#pkgnum +print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!; + +#svcpart +print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!; + +($domuser,$domsvc,$domuid)=( + $svc_acct_sm->domuser, + $svc_acct_sm->domsvc, + $svc_acct_sm->domuid, +); + +#domuser +print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!; + +#domsvc +print qq! \@ <SELECT NAME="domsvc" SIZE=1>!; +foreach $_ (keys %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" : "", + qq! VALUE="$_">$username{$_}!; +} +print "</SELECT>\@$mydomain mailbox."; + + #formatting + print "</PRE>\n"; + +print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!; + +print <<END; + + </FORM> + </BODY> +</HTML> +END + diff --git a/htdocs/edit/svc_domain.cgi b/htdocs/edit/svc_domain.cgi new file mode 100755 index 000000000..49be88073 --- /dev/null +++ b/htdocs/edit/svc_domain.cgi @@ -0,0 +1,164 @@ +#!/usr/bin/perl -Tw +# +# $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} +# +# ivan@voicenet.com 97-jan-5 -> 97-jan-6 +# +# changes for domain template 3.5 +# ivan@voicenet.com 97-jul-24 +# +# 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 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::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_domain; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +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!"; + + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; + + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + } else { #adding + + $svc_domain = new FS::svc_domain({}); + + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + $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) ); + } + } + + } +} +$action = $svcnum ? 'Edit' : 'Add'; + +$svc = $part_svc->getfield('svc'); + +$otaker = getotaker; + +$domain = $svc_domain->domain; + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; + <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST> + <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> + <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> + <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> +END + +print qq!<INPUT TYPE="radio" NAME="action" VALUE="N"!; +print ' CHECKED' if $kludge_action eq 'N'; +print qq!>New!; +print qq!<BR><INPUT TYPE="radio" NAME="action" VALUE="M"!; +print ' CHECKED' if $kludge_action eq 'M'; +print qq!>Transfer!; + +print <<END; +<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26> +<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 + <LI>ORG is for miscellaneous, usually, non-profit organizations + <LI>NET is for network infrastructure machines and organizations + <LI>EDU is for 4-year, degree granting institutions +<!-- <LI>GOV is for United States federal government agencies +!--> +</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). +!--> + </FORM> + </BODY> +</HTML> +END + |