diff options
Diffstat (limited to 'httemplate/edit')
30 files changed, 3878 insertions, 0 deletions
diff --git a/httemplate/edit/agent.cgi b/httemplate/edit/agent.cgi new file mode 100755 index 000000000..b4508da81 --- /dev/null +++ b/httemplate/edit/agent.cgi @@ -0,0 +1,112 @@ +<% +# +# $Id: agent.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/agent_type.cgi b/httemplate/edit/agent_type.cgi new file mode 100755 index 000000000..317fd60bc --- /dev/null +++ b/httemplate/edit/agent_type.cgi @@ -0,0 +1,128 @@ +<% +# +# $Id: agent_type.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/cust_credit.cgi b/httemplate/edit/cust_credit.cgi new file mode 100755 index 000000000..d3d0dc15f --- /dev/null +++ b/httemplate/edit/cust_credit.cgi @@ -0,0 +1,125 @@ +<% +# +# $Id: cust_credit.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/cust_main.cgi b/httemplate/edit/cust_main.cgi new file mode 100755 index 000000000..8902e3dce --- /dev/null +++ b/httemplate/edit/cust_main.cgi @@ -0,0 +1,432 @@ +<% +#<!-- $Id: cust_main.cgi,v 1.1 2001-07-30 07:36:04 ivan Exp $ --> + +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; + +$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'); + +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>Billing address", &itable("#cccccc"), <<END; +<TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3> +END + +print <<END; +<INPUT TYPE="text" NAME="last" VALUE="$last"> , +<INPUT TYPE="text" NAME="first" VALUE="$first"> +END + +print <<END; +</TD><TD ALIGN="right">SS#</TD><TD><INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11></TD></TR> +<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="company" VALUE="$company" SIZE=70></TD></TR> +<TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=70></TD></TR> +<TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=70></TD></TR> +<TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="city" VALUE="$city"></TD><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1"> +END + +$cust_main->country( $conf->config('countrydefault') || 'US' ) + unless $cust_main->country; +$cust_main->state( $conf->config('statedefault') || 'CA' ) + unless $cust_main->state || $cust_main->country ne 'US'; +foreach ( qsearch('cust_main_county',{}) ) { + print "<OPTION"; + print " SELECTED" if ( $cust_main->state eq $_->state + && $cust_main->county eq $_->county + && $cust_main->country eq $_->country + ); + print ">",$_->state; + print " (",$_->county,")" if $_->county; + print " / ", $_->country; +} +print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!; + +($daytime,$night,$fax)=( + $cust_main->daytime, + $cust_main->night, + $cust_main->fax, +); + +print <<END; +<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18></TD></TR> +<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18></TD></TR> +<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12></TD></TR> +END + +print "</TABLE>$r required fields<BR>"; + +# service address + +if ( defined $cust_main->dbdef_table->column('ship_last') ) { + + print "\n", <<END; + <SCRIPT> + function changed(what) { + what.form.same.checked = false; + } + function samechanged(what) { + if ( what.checked ) { +END +print " what.form.ship_$_.value = what.form.$_.value;\n" + for (qw( last first company address1 address2 city zip daytime night fax )); +print <<END; + what.form.ship_state.selectedIndex = what.form.state.selectedIndex; + } + } + </SCRIPT> +END + + print '<BR>Service address ', + '(<INPUT TYPE="checkbox" NAME="same" onClick="samechanged(this)"'; + unless ( $cust_main->ship_last ) { + print ' CHECKED'; + foreach ( + qw( last first company address1 address2 city state zip daytime night fax) + ) { + $cust_main->set("ship_$_", $cust_main->get($_) ); + } + } + print '>same as billing address)<BR>'; + + my($ship_last,$ship_first,$ship_company,$ship_address1,$ship_address2,$ship_city,$ship_zip)=( + $cust_main->ship_last, + $cust_main->ship_first, + $cust_main->ship_company, + $cust_main->ship_address1, + $cust_main->ship_address2, + $cust_main->ship_city, + $cust_main->ship_zip, + ); + + print &itable("#cccccc"), <<END; + <TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=5> +END + + print <<END; + <INPUT TYPE="text" NAME="ship_last" VALUE="$ship_last" onChange="changed(this)"> , + <INPUT TYPE="text" NAME="ship_first" VALUE="$ship_first" onChange="changed(this)"> +END + + print <<END; + </TD></TR> + <TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_company" VALUE="$ship_company" SIZE=70 onChange="changed(this)"></TD></TR> + <TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_address1" VALUE="$ship_address1" SIZE=70 onChange="changed(this)"></TD></TR> + <TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_address2" VALUE="$ship_address2" SIZE=70 onChange="changed(this)"></TD></TR> + <TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="ship_city" VALUE="$ship_city" onChange="changed(this)"></TD><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="ship_state" SIZE="1" onChange="changed(this)"> +END + + $cust_main->ship_country( $conf->config('countrydefault') || 'US' ) + unless $cust_main->ship_country; + $cust_main->ship_state( $conf->config('statedefault') || 'CA' ) + unless $cust_main->ship_state || $cust_main->ship_country ne 'US'; + foreach ( qsearch('cust_main_county',{}) ) { + print "<OPTION"; + print " SELECTED" if ( $cust_main->ship_state eq $_->state + && $cust_main->ship_county eq $_->county + && $cust_main->ship_country eq $_->country + ); + print ">",$_->state; + print " (",$_->county,")" if $_->county; + print " / ", $_->country; + } + print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="ship_zip" VALUE="$ship_zip" SIZE=10 onChange="changed(this)"></TD></TR>!; + + my($ship_daytime,$ship_night,$ship_fax)=( + $cust_main->ship_daytime, + $cust_main->ship_night, + $cust_main->ship_fax, + ); + + print <<END; + <TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_daytime" VALUE="$ship_daytime" SIZE=18 onChange="changed(this)"></TD></TR> + <TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_night" VALUE="$ship_night" SIZE=18 onChange="changed(this)"></TD></TR> + <TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_fax" VALUE="$ship_fax" SIZE=12 onChange="changed(this)"></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("#cccccc"), + 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("#cccccc"), "<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("#cccccc"), + 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/httemplate/edit/cust_main_county-expand.cgi b/httemplate/edit/cust_main_county-expand.cgi new file mode 100755 index 000000000..a7b0998df --- /dev/null +++ b/httemplate/edit/cust_main_county-expand.cgi @@ -0,0 +1,92 @@ +<% +# +# $Id: cust_main_county-expand.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/cust_main_county.cgi b/httemplate/edit/cust_main_county.cgi new file mode 100755 index 000000000..38e6d6877 --- /dev/null +++ b/httemplate/edit/cust_main_county.cgi @@ -0,0 +1,104 @@ +<% +# +# $Id: cust_main_county.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/cust_pay.cgi b/httemplate/edit/cust_pay.cgi new file mode 100755 index 000000000..33320648c --- /dev/null +++ b/httemplate/edit/cust_pay.cgi @@ -0,0 +1,101 @@ +<% +# +# $Id: cust_pay.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/cust_pkg.cgi b/httemplate/edit/cust_pkg.cgi new file mode 100755 index 000000000..637023703 --- /dev/null +++ b/httemplate/edit/cust_pkg.cgi @@ -0,0 +1,171 @@ +<% +# +# $Id: cust_pkg.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/part_pkg.cgi b/httemplate/edit/part_pkg.cgi new file mode 100755 index 000000000..002d54139 --- /dev/null +++ b/httemplate/edit/part_pkg.cgi @@ -0,0 +1,180 @@ +<% +# +# $Id: part_pkg.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/part_referral.cgi b/httemplate/edit/part_referral.cgi new file mode 100755 index 000000000..e7d76f7e4 --- /dev/null +++ b/httemplate/edit/part_referral.cgi @@ -0,0 +1,94 @@ +<% +# +# $Id: part_referral.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/part_svc.cgi b/httemplate/edit/part_svc.cgi new file mode 100755 index 000000000..cc0ee6fd0 --- /dev/null +++ b/httemplate/edit/part_svc.cgi @@ -0,0 +1,218 @@ +<!-- $Id: part_svc.cgi,v 1.1 2001-07-30 07:36:04 ivan Exp $ --> +<% + my $part_svc; + if ( $cgi->param('error') ) { #error + $part_svc = new FS::part_svc ( { + map { $_, scalar($cgi->param($_)) } fields('part_svc') + } ); + } elsif ( $cgi->keywords ) { #edit + my $query = $cgi->keywords; + $query =~ /^(\d+)$/; + $part_svc=qsearchs('part_svc',{'svcpart'=>$1}); + } else { #adding + $part_svc = new FS::part_svc {}; + } + my $action = $part_svc->svcpart ? 'Edit' : 'Add'; + my $hashref = $part_svc->hashref; + my $p_svcdb = $part_svc->svcdb || 'svc_acct'; + +%> + +<SCRIPT> +function visualize(what) { + if (document.getElementById) { + document.getElementById('d<%= $p_svcdb %>').style.visibility = "visible"; + } else { + document.l<%= $p_svcdb %>.visibility = "visible"; + } +} +</SCRIPT> + +<%= header("$action Service Definition", + menubar( 'Main Menu' => $p, + 'View all services' => "${p}browse/part_svc.cgi" + ), + " onLoad=\"visualize()\"" + ) +%> + +<% if ( $cgi->param('error') ) { %> +<FONT SIZE="+1" COLOR="#ff0000">Error: <%= $cgi->param('error') %></FONT> +<% } %> + +<FORM NAME="dummy"> + + Service Part #<%= $part_svc->svcpart ? $part_svc->svcpart : "(NEW)" %> + +<PRE> +Service <INPUT TYPE="text" NAME="svc" VALUE="<%= $hashref->{svc} %>"> +</PRE> +Services are items you offer to your customers. +<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts + <LI>svc_domain - Virtual domains + <LI>svc_acct_sm - Virtual domain mail aliasing + <LI>svc_www - Virtual domain website +<!-- <LI>svc_charge - One-time charges (Partially unimplemented) + <LI>svc_wo - Work orders (Partially unimplemented) +--> +</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> +<SCRIPT> +var svcdb = null; +var something = null; +function changed(what) { + svcdb = what.options[what.selectedIndex].value; +<% foreach my $svcdb ( qw( svc_acct svc_domain svc_acct_sm svc_www ) ) { %> + if (svcdb == "<%= $svcdb %>" ) { + <% foreach my $not ( grep { $_ ne $svcdb } ( + qw(svc_acct svc_domain svc_acct_sm svc_www) ) ) { %> + if (document.getElementById) { + document.getElementById('d<%= $not %>').style.visibility = "hidden"; + } else { + document.l<%= $not %>.visibility = "hidden"; + } + <% } %> + if (document.getElementById) { + document.getElementById('d<%= $svcdb %>').style.visibility = "visible"; + } else { + document.l<%= $svcdb %>.visibility = "visible"; + } + } +<% } %> +} +</SCRIPT> +Table<SELECT NAME="svcdb" SIZE=1 onChange="changed(this)"> +<% foreach my $svcdb (qw( svc_acct svc_domain svc_acct_sm svc_www )) { %> +<OPTION VALUE="<%= $svcdb %>" <%= ' SELECTED'x($svcdb eq $hashref->{svcdb}) %>><%= $svcdb %> +<% } %> +</SELECT> + +<% +#these might belong somewhere else for other user interfaces +#pry need to eventually create stuff that's shared amount UIs +my %defs = ( + 'svc_acct' => { + 'dir' => 'Home directory', + 'uid' => 'UID (set to fixed and blank for dial-only)', + 'slipip' => 'IP address (set to fixed and blank to disable dialin)', + 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!, + 'username' => 'Username', + 'quota' => '(unimplemented)', + '_password' => 'Password', + 'gid' => 'GID (when blank, defaults to UID)', + 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)', + 'finger' => 'GECOS', + }, + 'svc_domain' => { + 'domain' => 'Domain', + }, + 'svc_acct_sm' => { + 'domuser' => 'domuser@virtualdomain.com', + 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded', + 'domsvc' => 'svcnum from svc_domain for virtualdomain.com', + }, + 'svc_charge' => { + 'amount' => 'amount', + }, + 'svc_wo' => { + 'worker' => 'Worker', + '_date' => 'Date', + }, + 'svc_www' => { + #'recnum' => '', + #'usersvc' => '', + }, +); + +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo +foreach my $svcdb ( qw( + konq_kludge svc_acct svc_domain svc_acct_sm svc_www +) ) { + + my(@rows)=map { /^${svcdb}__(.*)$/; $1 } + grep ! /_flag$/, + grep /^${svcdb}__/, + fields('part_svc'); + #my($rowspan)=scalar(@rows); + + #my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>"; +# $visibility = $svcdb eq $part_svc->svcdb ? "SHOW" : "HIDDEN"; +# $visibility = $svcdb eq $p_svcdb ? "visible" : "hidden"; + my $visibility = "hidden"; +%> +<SCRIPT> +if (document.getElementById) { + document.write("<DIV ID=\"d<%= $svcdb %>\" STYLE=\"visibility: <%= $visibility %>; position: absolute\">"); +} else { +<% $visibility="show" if $visibility eq "visible"; %> + document.write("<LAYER ID=\"l<%= $svcdb %>\" VISIBILITY=\"<%= $visibility %>\">"); +} + +function fixup(what) { + what.svc.value = document.dummy.svc.value; + what.svcdb.value = document.dummy.svcdb.options[document.dummy.svcdb.selectedIndex].value +} +</SCRIPT> +<FORM NAME="<%= $svcdb %>" ACTION="process/part_svc.cgi" METHOD=POST onSubmit="fixup(this)"> +<INPUT TYPE="hidden" NAME="svcpart" VALUE="<%= $hashref->{svcpart} %>"> +<INPUT TYPE="hidden" NAME="svc" VALUE="<%= $hashref->{svc} %>"> +<INPUT TYPE="hidden" NAME="svcdb" VALUE="<%= $svcdb %>"> +<% + print "$svcdb" unless $svcdb eq 'konq_kludge'; + print "<BR><TABLE BORDER=1><TH>Field</TH><TH COLSPAN=2>Modifier</TH>" unless $svcdb eq 'konq_kludge'; + + 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 "<TR><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>" unless $svcdb eq 'konq_kludge'; + +print qq!\n<BR><INPUT TYPE="submit" VALUE="!, + $hashref->{svcpart} ? "Apply changes" : "Add service", + qq!">! unless $svcdb eq 'konq_kludge'; + + print "</FORM>"; + print <<END; + <SCRIPT> + if (document.getElementById) { + document.write("</DIV>"); + } else { + document.write("</LAYER>"); + } + </SCRIPT> +END +} +#print "</TABLE>"; +%> + +<TAG onLoad=" + if (document.getElementById) { + document.getElementById('d<%= $p_svcdb %>').style.visibility = 'visible'; + } else { + document.l<%= $p_svcdb %>.visibility = 'visible'; + } +"> + + </BODY> +</HTML> + diff --git a/httemplate/edit/process/agent.cgi b/httemplate/edit/process/agent.cgi new file mode 100755 index 000000000..2b4991363 --- /dev/null +++ b/httemplate/edit/process/agent.cgi @@ -0,0 +1,73 @@ +<% +# +# $Id: agent.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/agent_type.cgi b/httemplate/edit/process/agent_type.cgi new file mode 100755 index 000000000..5c6b2b8e0 --- /dev/null +++ b/httemplate/edit/process/agent_type.cgi @@ -0,0 +1,100 @@ +<% +# +# $Id: agent_type.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/cust_credit.cgi b/httemplate/edit/process/cust_credit.cgi new file mode 100755 index 000000000..3cacab26e --- /dev/null +++ b/httemplate/edit/process/cust_credit.cgi @@ -0,0 +1,80 @@ +<% +# +# $Id: cust_credit.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/cust_main.cgi b/httemplate/edit/process/cust_main.cgi new file mode 100755 index 000000000..6c52113ba --- /dev/null +++ b/httemplate/edit/process/cust_main.cgi @@ -0,0 +1,196 @@ +<% +# +# $Id: cust_main.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/cust_main_county-expand.cgi b/httemplate/edit/process/cust_main_county-expand.cgi new file mode 100755 index 000000000..b7c4547f6 --- /dev/null +++ b/httemplate/edit/process/cust_main_county-expand.cgi @@ -0,0 +1,104 @@ +<% +# +# $Id: cust_main_county-expand.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/cust_main_county.cgi b/httemplate/edit/process/cust_main_county.cgi new file mode 100755 index 000000000..1ff2047f1 --- /dev/null +++ b/httemplate/edit/process/cust_main_county.cgi @@ -0,0 +1,64 @@ +<% +# +# $Id: cust_main_county.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/cust_pay.cgi b/httemplate/edit/process/cust_pay.cgi new file mode 100755 index 000000000..f21ff490a --- /dev/null +++ b/httemplate/edit/process/cust_pay.cgi @@ -0,0 +1,71 @@ +<% +# +# $Id: cust_pay.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/cust_pkg.cgi b/httemplate/edit/process/cust_pkg.cgi new file mode 100755 index 000000000..0074466c8 --- /dev/null +++ b/httemplate/edit/process/cust_pkg.cgi @@ -0,0 +1,84 @@ +<% +# +# $Id: cust_pkg.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/part_pkg.cgi b/httemplate/edit/process/part_pkg.cgi new file mode 100755 index 000000000..3e1c07d1e --- /dev/null +++ b/httemplate/edit/process/part_pkg.cgi @@ -0,0 +1,152 @@ +<% +# +# $Id: part_pkg.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/part_referral.cgi b/httemplate/edit/process/part_referral.cgi new file mode 100755 index 000000000..c79ebb608 --- /dev/null +++ b/httemplate/edit/process/part_referral.cgi @@ -0,0 +1,69 @@ +<% +# +# $Id: part_referral.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/part_svc.cgi b/httemplate/edit/process/part_svc.cgi new file mode 100755 index 000000000..4c972e4d7 --- /dev/null +++ b/httemplate/edit/process/part_svc.cgi @@ -0,0 +1,30 @@ +<% + +my $svcpart = $cgi->param('svcpart'); + +my $old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; + +my $new = new FS::part_svc ( { + map { + $_, scalar($cgi->param($_)); +# } qw(svcpart svc svcdb) + } fields('part_svc') +} ); + +my $error; +if ( $svcpart ) { + $error = $new->replace($old); +} else { + $error = $new->insert; + $svcpart=$new->getfield('svcpart'); +} + +if ( $error ) { + $cgi->param('error', $error); + $Response->Redirect(popurl(2). "part_svc.cgi?". $cgi->query_string ); +} else { + warn "redirecting to ". popurl(3)."browse/part_svc.cgi via $Response"; + $Response->Redirect(popurl(3)."browse/part_svc.cgi"); +} + +%> diff --git a/httemplate/edit/process/svc_acct.cgi b/httemplate/edit/process/svc_acct.cgi new file mode 100755 index 000000000..e895e5ddf --- /dev/null +++ b/httemplate/edit/process/svc_acct.cgi @@ -0,0 +1,100 @@ +<% +# +# $Id: svc_acct.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/svc_acct_pop.cgi b/httemplate/edit/process/svc_acct_pop.cgi new file mode 100755 index 000000000..95415f201 --- /dev/null +++ b/httemplate/edit/process/svc_acct_pop.cgi @@ -0,0 +1,70 @@ +<% +# +# $Id: svc_acct_pop.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/svc_acct_sm.cgi b/httemplate/edit/process/svc_acct_sm.cgi new file mode 100755 index 000000000..a68478898 --- /dev/null +++ b/httemplate/edit/process/svc_acct_sm.cgi @@ -0,0 +1,87 @@ +<% +# +# $Id: svc_acct_sm.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/process/svc_domain.cgi b/httemplate/edit/process/svc_domain.cgi new file mode 100755 index 000000000..59a0c078f --- /dev/null +++ b/httemplate/edit/process/svc_domain.cgi @@ -0,0 +1,84 @@ +<% +# +# $Id: svc_domain.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/svc_acct.cgi b/httemplate/edit/svc_acct.cgi new file mode 100755 index 000000000..7badfe696 --- /dev/null +++ b/httemplate/edit/svc_acct.cgi @@ -0,0 +1,232 @@ +<% +# +# $Id: svc_acct.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/svc_acct_pop.cgi b/httemplate/edit/svc_acct_pop.cgi new file mode 100755 index 000000000..016031f83 --- /dev/null +++ b/httemplate/edit/svc_acct_pop.cgi @@ -0,0 +1,106 @@ +<% +# +# $Id: svc_acct_pop.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/svc_acct_sm.cgi b/httemplate/edit/svc_acct_sm.cgi new file mode 100755 index 000000000..891c3e1f6 --- /dev/null +++ b/httemplate/edit/svc_acct_sm.cgi @@ -0,0 +1,251 @@ +<% +# +# $Id: svc_acct_sm.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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/httemplate/edit/svc_domain.cgi b/httemplate/edit/svc_domain.cgi new file mode 100755 index 000000000..dd8ad8532 --- /dev/null +++ b/httemplate/edit/svc_domain.cgi @@ -0,0 +1,168 @@ +<% +# +# $Id: svc_domain.cgi,v 1.1 2001-07-30 07:36:04 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.1 2001-07-30 07:36:04 ivan +# templates!!! +# +# 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 + +%> |