diff options
Diffstat (limited to 'htdocs/edit')
30 files changed, 0 insertions, 3871 deletions
diff --git a/htdocs/edit/agent.cgi b/htdocs/edit/agent.cgi deleted file mode 100755 index 5b42095b3..000000000 --- a/htdocs/edit/agent.cgi +++ /dev/null @@ -1,108 +0,0 @@ -#!/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 deleted file mode 100755 index bdf64c58f..000000000 --- a/htdocs/edit/agent_type.cgi +++ /dev/null @@ -1,124 +0,0 @@ -#!/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 deleted file mode 100755 index 35c4d48fe..000000000 --- a/htdocs/edit/cust_credit.cgi +++ /dev/null @@ -1,121 +0,0 @@ -#!/usr/bin/perl -Tw -# -# $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 ] -# -# 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. -# -# ivan@voicenet.com 96-dec-05 -# -# paybatch field, differentiates between credits & credits+refunds by commandline -# ivan@voicenet.com 96-dec-08 -# -# added (but commented out) sprintf("%.2f" in amount field. Hmm. -# ivan@voicenet.com 97-jan-3 -# -# paybatch stuff thrown out - has checkbox now instead. -# (well, sort of. still passed around for backward compatability and possible editing hook) -# 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; -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; - -$cgi = new CGI; -cgisuidsetup($cgi); - -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; - <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST> - <PRE> -END - -$crednum = ""; -print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!; - -print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; - -print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!; - -print qq!\nDate: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="">!; - -print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!; -print qq!<INPUT TYPE="hidden" NAME="credited" VALUE="">!; - -#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!; - -print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!; - -print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!; - -print <<END; -</PRE> -<BR> -<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER> -END - -print <<END; - - </FORM> - </BODY> -</HTML> -END - diff --git a/htdocs/edit/cust_main.cgi b/htdocs/edit/cust_main.cgi deleted file mode 100755 index b3d9f0d80..000000000 --- a/htdocs/edit/cust_main.cgi +++ /dev/null @@ -1,513 +0,0 @@ -#!/usr/bin/perl -Tw -# -# $Id: cust_main.cgi,v 1.28 2000-12-26 23:51:40 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.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; -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 deleted file mode 100755 index 783e92826..000000000 --- a/htdocs/edit/cust_main_county-expand.cgi +++ /dev/null @@ -1,88 +0,0 @@ -#!/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 deleted file mode 100755 index 747a63df6..000000000 --- a/htdocs/edit/cust_main_county.cgi +++ /dev/null @@ -1,100 +0,0 @@ -#!/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 deleted file mode 100755 index 5dee76ed9..000000000 --- a/htdocs/edit/cust_pay.cgi +++ /dev/null @@ -1,97 +0,0 @@ -#!/usr/bin/perl -Tw -# -# $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 -# -# 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; -use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup); -use FS::CGI qw(header popurl); - -$cgi = new CGI; -cgisuidsetup($cgi); - -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'); - -print <<END; - <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST> - <HR><PRE> -END - -print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!; - -print qq!<BR>Date: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!; - -print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8>!; - -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?) -print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!; - -#paybatch -print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!; - -print <<END; -</PRE> -<BR> -<INPUT TYPE="submit" VALUE="Post payment"> -END - -print <<END; - - </FORM> - </BODY> -</HTML> -END - diff --git a/htdocs/edit/cust_pkg.cgi b/htdocs/edit/cust_pkg.cgi deleted file mode 100755 index b3c92249f..000000000 --- a/htdocs/edit/cust_pkg.cgi +++ /dev/null @@ -1,167 +0,0 @@ -#!/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 deleted file mode 100755 index f7ade88c8..000000000 --- a/htdocs/edit/part_pkg.cgi +++ /dev/null @@ -1,176 +0,0 @@ -#!/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 deleted file mode 100755 index 24ac9dd82..000000000 --- a/htdocs/edit/part_referral.cgi +++ /dev/null @@ -1,90 +0,0 @@ -#!/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 deleted file mode 100755 index 4c70f0762..000000000 --- a/htdocs/edit/part_svc.cgi +++ /dev/null @@ -1,199 +0,0 @@ -#!/usr/bin/perl -Tw -# -# $Id: part_svc.cgi,v 1.13 2000-06-15 11:10:31 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.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 -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 - ); - 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_acct svc_domain svc_acct_sm svc_charge svc_wo -foreach $svcdb ( qw( - svc_acct svc_domain svc_acct_sm -) ) { - - 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 deleted file mode 100755 index c1b397aac..000000000 --- a/htdocs/edit/process/agent.cgi +++ /dev/null @@ -1,69 +0,0 @@ -#!/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 deleted file mode 100755 index 99c54ab3b..000000000 --- a/htdocs/edit/process/agent_type.cgi +++ /dev/null @@ -1,96 +0,0 @@ -#!/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 deleted file mode 100755 index ea9c5a3a2..000000000 --- a/htdocs/edit/process/cust_credit.cgi +++ /dev/null @@ -1,76 +0,0 @@ -#!/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 deleted file mode 100755 index 25dc0299b..000000000 --- a/htdocs/edit/process/cust_main.cgi +++ /dev/null @@ -1,192 +0,0 @@ -#!/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 deleted file mode 100755 index a174a0a8e..000000000 --- a/htdocs/edit/process/cust_main_county-expand.cgi +++ /dev/null @@ -1,100 +0,0 @@ -#!/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 deleted file mode 100755 index 0fc1708c5..000000000 --- a/htdocs/edit/process/cust_main_county.cgi +++ /dev/null @@ -1,60 +0,0 @@ -#!/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 deleted file mode 100755 index ca5029c3c..000000000 --- a/htdocs/edit/process/cust_pay.cgi +++ /dev/null @@ -1,67 +0,0 @@ -#!/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 deleted file mode 100755 index 9d82b3c24..000000000 --- a/htdocs/edit/process/cust_pkg.cgi +++ /dev/null @@ -1,80 +0,0 @@ -#!/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 deleted file mode 100755 index 5af9055d6..000000000 --- a/htdocs/edit/process/part_pkg.cgi +++ /dev/null @@ -1,148 +0,0 @@ -#!/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 deleted file mode 100755 index cde27ede1..000000000 --- a/htdocs/edit/process/part_referral.cgi +++ /dev/null @@ -1,65 +0,0 @@ -#!/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 deleted file mode 100755 index 0b3e2cd1c..000000000 --- a/htdocs/edit/process/part_svc.cgi +++ /dev/null @@ -1,69 +0,0 @@ -#!/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 deleted file mode 100755 index 84f93abe8..000000000 --- a/htdocs/edit/process/svc_acct.cgi +++ /dev/null @@ -1,96 +0,0 @@ -#!/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 deleted file mode 100755 index 763bca4a8..000000000 --- a/htdocs/edit/process/svc_acct_pop.cgi +++ /dev/null @@ -1,66 +0,0 @@ -#!/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 deleted file mode 100755 index 9c39bb8e5..000000000 --- a/htdocs/edit/process/svc_acct_sm.cgi +++ /dev/null @@ -1,83 +0,0 @@ -#!/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 deleted file mode 100755 index ad1892dd1..000000000 --- a/htdocs/edit/process/svc_domain.cgi +++ /dev/null @@ -1,80 +0,0 @@ -#!/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 deleted file mode 100755 index 963bc1edf..000000000 --- a/htdocs/edit/svc_acct.cgi +++ /dev/null @@ -1,228 +0,0 @@ -#!/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 deleted file mode 100755 index 1797b2b8e..000000000 --- a/htdocs/edit/svc_acct_pop.cgi +++ /dev/null @@ -1,102 +0,0 @@ -#!/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 deleted file mode 100755 index cb7cbfae0..000000000 --- a/htdocs/edit/svc_acct_sm.cgi +++ /dev/null @@ -1,247 +0,0 @@ -#!/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 deleted file mode 100755 index 49be88073..000000000 --- a/htdocs/edit/svc_domain.cgi +++ /dev/null @@ -1,164 +0,0 @@ -#!/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 - |