diff options
32 files changed, 577 insertions, 404 deletions
@@ -27,5 +27,8 @@ Thanks! Mark Williamson <mark.williamson@ebbs.com.au> and Roger Mangraviti <rem@atu.com.au> contributed state/provence listings for Australia. +Peter Wemm <peter@netplex.com.au> sent in a bunch of bugfixes for the 1.2 +release. + Everything else is my (Ivan Kohler <ivan@sisd.com>) fault. @@ -1,4 +1,4 @@ -$Id: TODO,v 1.21 1999-02-06 22:43:24 ivan Exp $ +$Id: TODO,v 1.22 1999-02-07 09:59:12 ivan Exp $ If you are interested in helping with any of these, please join the mailing list (send a blank message to ivan-freeside-subscribe@sisd.com) to avoid @@ -6,23 +6,9 @@ duplication of effort. -- before 1.2b1 -- -Can't use [e]idiot with mod_perl (not with forms and `press back button' and -expire=>now, anyway). - -"popurlidiot" is not exported by the FS::CGI module at htdocs/misc/process/link.cgi line 27 -Content-type: text/html - -<H1>Software error:</H1> -<CODE>Can't continue after import errors at htdocs/misc/process/link.cgi line 27 -BEGIN failed--compilation aborted at htdocs/misc/process/link.cgi line 27. -</CODE> -<P> -For help, please send mail to this site's webmaster, giving this error message -and the time and date of the error. - -[Fri Feb 5 02:26:23 1999] link.cgi: Can't continue after import errors at htdocs/misc/process/link.cgi line 27 -[Fri Feb 5 02:26:23 1999] link.cgi: BEGIN failed--compilation aborted at htdocs/misc/process/link.cgi line 27. +missed popurl in (at least) search/cust_pkg.cgi +one-screen new customer entry clean up view/cust_pkg and view/svc_* yuck! @@ -40,9 +26,6 @@ Add the ability for services to filter information up to the package level for invoices and web screens, so you can select a particlar package based on username or domain name, etc. -You can't delete the stuff under administration yet. Add this, -_including_ making sure the thing you are deleting is not in use! - (Test this) one-time/per-customer/? changes in rates and descriptions ('remembered invoices'): implement by creating a new package on the fly... but it isn't @@ -56,7 +39,10 @@ update site_perl/table_template* (pry out of date) update web demo --- before or after --- +-- release 1.2b1 --- + +You can't delete the stuff under administration yet. Add this, +_including_ making sure the thing you are deleting is not in use! add links on view/cust_main.cgi to setup services, like view/cust_pkg.cgi @@ -80,12 +66,13 @@ whois accordingly. .us domains and others! site_perl/svc_domain.cgi (hmm... or maybe should have a button? or maybe svc_domain.pm should handle this) should set $whois_hack for non-internic domains, so you can add them... +turn on the depriciation warnings for [e]idiot in FS::CGI. Stop using [e]idiot +the last places it is (htdocs/search/ htdocs/misc/ htdocs/misc/process) + (test cust_main.pm with cybercash v2 and v3, especially with the callback stuff AND with mod_perl w/cybercash v2 kludge in package main) (callback stuff should be eliminated by now) --- after -- - bah, table/itable/*table in FS::CGI is silly. doc Apache::AuthDBI as well diff --git a/bin/fs-setup b/bin/fs-setup index 2683e98ad..f028c6e1d 100755 --- a/bin/fs-setup +++ b/bin/fs-setup @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: fs-setup,v 1.13 1999-02-04 06:09:23 ivan Exp $ +# $Id: fs-setup,v 1.14 1999-02-07 09:59:14 ivan Exp $ # # ivan@sisd.com 97-nov-8,9 # @@ -32,7 +32,10 @@ # fix radius attributes ivan@sisd.com 98-sep-27 # # $Log: fs-setup,v $ -# Revision 1.13 1999-02-04 06:09:23 ivan +# Revision 1.14 1999-02-07 09:59:14 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.13 1999/02/04 06:09:23 ivan # add AU provences # # Revision 1.12 1999/02/03 10:42:27 ivan @@ -374,7 +377,7 @@ sub tables_hash_hack { 'address2', 'varchar', 'NULL', $char_d, 'city', 'varchar', '', $char_d, 'county', 'varchar', 'NULL', $char_d, - 'state', 'varchar', '', $char_d, + 'state', 'varchar', 'NULL', $char_d, 'zip', 'varchar', '', 10, 'country', 'char', '', 2, 'daytime', 'varchar', 'NULL', 20, @@ -410,7 +413,7 @@ sub tables_hash_hack { # a tax rate. 'columns' => [ 'taxnum', 'int', '', '', - 'state', 'char', 'NULL', $char_d, + 'state', 'varchar', 'NULL', $char_d, 'county', 'varchar', 'NULL', $char_d, 'country', 'char', '', 2, 'tax', 'real', '', '', #tax % @@ -447,7 +450,7 @@ sub tables_hash_hack { 'address1', 'varchar', '', $char_d, 'address2', 'varchar', 'NULL', $char_d, 'city', 'varchar', '', $char_d, - 'state', 'char', '', 2, + 'state', 'varchar', '', $char_d, 'zip', 'varchar', '', 10, 'country', 'char', '', 2, 'trancode', 'int', '', '', @@ -567,7 +570,7 @@ sub tables_hash_hack { 'columns' => [ 'popnum', 'int', '', '', 'city', 'varchar', '', $char_d, - 'state', 'char', '', 2, + 'state', 'varchar', '', $char_d, 'ac', 'char', '', 3, 'exch', 'char', '', 3, #rest o' number? diff --git a/htdocs/docs/export.html b/htdocs/docs/export.html index d8022ae45..86a2b4ccd 100644 --- a/htdocs/docs/export.html +++ b/htdocs/docs/export.html @@ -4,7 +4,8 @@ <body> <h1>File exporting</h1> <ul> - <li>bin/svc_acct.export will create UNIX <b>passwd</b>, <b>shadow</b> and <b>master.passwd</b> files, ERPCD <b>acp_passwd</b> and <b>acp_dialup</b> files and a RADIUS <b>users</b> file in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below. + <li>bin/svc_acct.export will create UNIX <b>passwd</b>, <b>shadow</b> and <b>master.passwd</b> files, ERPCD <b>acp_passwd</b> and <b>acp_dialup</b> files and a RADIUS <b>users</b> file in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below. Some RADIUS servers (such as <a href="http://www.open.com.au/radiator/">Radiator</a>) will authenticate directly out of an SQL database. In these cases, +it is reccommended that you copy the svc_acct table to an external RADIUS machine rather than run the RADIUS server on your Freeside machine. <ul> <li>shellmachines - <b>passwd</b> and <b>shadow</b> are copied to the remote machine as <b>/etc/passwd.new</b> and <b>/etc/shadow.new</b> and then moved to <b>/etc/passwd</b> and <b>/etc/shadow</b> if no errors occur. <li>bsdshellmachines - <b>passwd</b> and <b>master.passwd</b> are copied to the remote machine as <b>/etc/passwd.new</b> and <b>/etc/master.passwd.new</b> and moved to <b>/etc/passwd</b> and <b>/etc/master.passwd</b> if no errors occur. diff --git a/htdocs/docs/schema.html b/htdocs/docs/schema.html index 6f4d99937..f50525183 100644 --- a/htdocs/docs/schema.html +++ b/htdocs/docs/schema.html @@ -77,6 +77,7 @@ <li>destnum - primary key <li>custnum - <a href="#cust_main">customer</a> <li>dest - Invoice destination: If numeric, a <a href="#svc_acct">svcnum</a>, if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist) + </ul> <li><a name="cust_main_county">cust_main_county</a> - Tax rates <ul> <li>taxnum - primary key diff --git a/htdocs/docs/trouble.html b/htdocs/docs/trouble.html index dcbe1bbd2..c918138c8 100644 --- a/htdocs/docs/trouble.html +++ b/htdocs/docs/trouble.html @@ -31,12 +31,8 @@ at <i>/your/path</i>/site_perl/FS/UID.pm line 26. BEGIN failed--compilation aborted at <i>/your/path</i>/edit/process/part_svc.cgi line 15. </pre> - Then the scripts are not running setuid freeside. If you were editing -the files, it is possible you inadvertantly removed the setuid bit. -As mentioned in the <a href="install.html">New Installation</a> section of the documentation, set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds. -<pre>cd /usr/local/apache/htdocs/freeside -chown -R freeside . -chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre> + Then the scripts are not running as the freeside freeside user. See +the <a href="install.html">New Installation</a> section of the documentation. <li>If you receive `can not connect to server' errors using MySQL on a system that doesn't support native threading, you may need to specify the full hostname in your DBI datasource. See the <a href="http://www.mysql.com/Manual_chapter/manual_Problems.html#Can_not_connect_to_server">MySQL documentation</a>, DBI manpage and the DBD::mysql manpage for details. </ul> </body> diff --git a/htdocs/edit/cust_pkg.cgi b/htdocs/edit/cust_pkg.cgi index ed4200830..afe6f8770 100755 --- a/htdocs/edit/cust_pkg.cgi +++ b/htdocs/edit/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cust_pkg.cgi,v 1.4 1999-01-19 05:13:38 ivan Exp $ +# $Id: cust_pkg.cgi,v 1.5 1999-02-07 09:59:18 ivan Exp $ # # this is for changing packages around, not editing things within the package # @@ -25,7 +25,10 @@ # 98-jun-1 # # $Log: cust_pkg.cgi,v $ -# Revision 1.4 1999-01-19 05:13:38 ivan +# Revision 1.5 1999-02-07 09:59:18 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:38 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -38,60 +41,62 @@ # use strict; -use vars qw( $cgi %pkg %comment $query $custnum $otaker $p1 @cust_pkg - $cust_main $agent $type_pkgs $count ); +use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg + $cust_main $agent $type_pkgs $count %remove_pkg ); use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup getotaker); +use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); use FS::CGI qw(header popurl); use FS::part_pkg; - -$cgi = new CGI; -&cgisuidsetup($cgi); +use FS::type_pkgs; foreach (qsearch('part_pkg', {})) { $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg'); $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment'); } -#untaint custnum - -($query) = $cgi->keywords; -$query =~ /^(\d+)$/; -$custnum = $1; +$cgi = new CGI; +&cgisuidsetup($cgi); -$otaker = &getotaker; +if ( $cgi->param('error') ) { + $custnum = $cgi->param('custnum'); + %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg'); +} else { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + undef %remove_pkg; +} $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''), <<END; - <FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST> - <HR> -END +print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -#custnum -print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!; +print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!; -#current packages (except cancelled packages) -@cust_pkg = grep ! $_->getfield('cancel'), - qsearch('cust_pkg',{'custnum'=>$custnum}); +print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; + +#current packages +@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } ); if (@cust_pkg) { print <<END; -<CENTER><FONT SIZE="+2">Current packages</FONT></CENTER> -These are packages the customer currently has. Select those packages you -wish to remove (if any).<BR><BR> +Current packages - select to remove (services are moved to a new package below) +<BR><BR> END my ($count) = 0 ; - print qq!<CENTER><TABLE>! ; + print qq!<TABLE>! ; foreach (@cust_pkg) { - print qq!<TR>! if ($count ==0) ; + print '<TR>' if $count == 0; my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') ); - print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum">!, - #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!, - #now you've got to admit this bug was pretty cool - qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!; + print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!; + print " CHECKED" if $remove_pkg{$pkgnum}; + print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!; $count ++ ; if ($count == 2) { @@ -99,28 +104,25 @@ END print qq!</TR>\n! ; } } - print qq!</TABLE></CENTER>! ; - - print "<HR>"; + print qq!</TABLE><BR><BR>!; } print <<END; -<CENTER><FONT SIZE="+2">New packages</FONT></CENTER> -These are packages the customer can purchase. Specify the quantity to add -of each package.<BR><BR> +Order new packages<BR><BR> END $cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); $agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); $count = 0 ; -print qq!<CENTER><TABLE>! ; +print qq!<TABLE>! ; foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { my($pkgpart)=$type_pkgs->pkgpart; print qq!<TR>! if ($count == 0) ; + my $value = $cgi->param("pkg$pkgpart") || 0; print <<END; <TD> - <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2"> + <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2"> $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n END $count ++ ; @@ -130,13 +132,10 @@ END $count = 0 ; } } -print qq!</TABLE></CENTER>! ; - -#otaker -print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!; +print qq!</TABLE>! ; #submit -print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!; +print qq!<P><INPUT TYPE="submit" VALUE="Order">\n!; print <<END; </FORM> diff --git a/htdocs/edit/part_pkg.cgi b/htdocs/edit/part_pkg.cgi index e7ac2aeb2..f7ade88c8 100755 --- a/htdocs/edit/part_pkg.cgi +++ b/htdocs/edit/part_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_pkg.cgi,v 1.8 1999-01-19 05:13:39 ivan Exp $ +# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $ # # part_pkg.cgi: Add/Edit package (output form) # @@ -13,7 +13,10 @@ # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 # # $Log: part_pkg.cgi,v $ -# Revision 1.8 1999-01-19 05:13:39 ivan +# Revision 1.9 1999-02-07 09:59:19 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.8 1999/01/19 05:13:39 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -42,7 +45,7 @@ use vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; @@ -64,24 +67,36 @@ if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { } ($query) = $cgi->keywords; +$action = ''; +$part_pkg = ''; +if ( $cgi->param('error') ) { + $part_pkg = new FS::part_pkg ( { + map { $_, scalar($cgi->param($_)) } fields('part_pkg') + } ); +} if ( $cgi->param('clone') ) { $action='Custom Pricing'; my $old_part_pkg = qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } ); - $part_pkg = $old_part_pkg->clone; -} elsif ( $query =~ /^(\d+)$/ ) { - $action='Edit'; - $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1}); + $part_pkg ||= $old_part_pkg->clone; +} elsif ( $query && $query =~ /^(\d+)$/ ) { + $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1}); } else { - $action='Add'; - $part_pkg = new FS::part_pkg {}; + $part_pkg ||= new FS::part_pkg {}; } +$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add'; $hashref = $part_pkg->hashref; print $cgi->header( '-expires' => 'now' ), header("$action Package Definition", menubar( 'Main Menu' => popurl(2), 'View all packages' => popurl(2). 'browse/part_pkg.cgi', -)), '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; if ( $cgi->param('clone') ) { print qq!<INPUT TYPE="hidden" NAME="clone" VALUE="!, $cgi->param('clone'), qq!">!; @@ -113,34 +128,34 @@ Enter the quantity of each service this package includes.<BR><BR> END } -foreach $part_svc ( qsearch('part_svc',{}) ) { - - my($svcpart)=$part_svc->getfield('svcpart'); - my($pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $cgi->param('clone') || $part_pkg->getfield('pkgpart'), +$count = 0; +foreach $part_svc ( ( qsearch( 'part_svc', {} ) ) ) { + my $svcpart = $part_svc->svcpart; + my $pkg_svc = qsearchs( 'pkg_svc', { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, 'svcpart' => $svcpart, - }) || new FS::pkg_svc({ - 'pkgpart' => $part_pkg->getfield('pkgpart'), + } ) || new FS::pkg_svc ( { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, 'svcpart' => $svcpart, 'quantity' => 0, }); - next unless $pkg_svc; + #? #next unless $pkg_svc; - unless ( $cgi->param('clone') ) { - print qq!<TR>! if $count == 0 ; + unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) { + print '<TR>' if $count == 0 ; print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!, - $pkg_svc->getfield('quantity') || 0,qq!"></TD>!, - qq!<TD><A HREF="part_svc.cgi?!,$part_svc->getfield('svcpart'), + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, + qq!"></TD><TD><A HREF="part_svc.cgi?!,$part_svc->svcpart, qq!">!, $part_svc->getfield('svc'), "</A></TD>"; - $count ++ ; + $count++; if ($count == 2) { - print qq!</TR>! ; - $count = 0 ; + print '</TR>'; + $count = 0; } } else { print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!, - $pkg_svc->getfield('quantity') || 0, qq!">\n!; + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!; } } diff --git a/htdocs/edit/part_referral.cgi b/htdocs/edit/part_referral.cgi index 6fd75f851..ed3b2678e 100755 --- a/htdocs/edit/part_referral.cgi +++ b/htdocs/edit/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_referral.cgi,v 1.4 1999-01-19 05:13:41 ivan Exp $ +# $Id: part_referral.cgi,v 1.5 1999-02-07 09:59:20 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -12,7 +12,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_referral.cgi,v $ -# Revision 1.4 1999-01-19 05:13:41 ivan +# Revision 1.5 1999-02-07 09:59:20 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:41 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -25,19 +28,20 @@ # use strict; -use vars qw( $cgi $part_referral $action $hashref $p1 ); +use vars qw( $cgi $part_referral $action $hashref $p1 $query ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); use FS::part_referral; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); $cgi = new CGI; &cgisuidsetup($cgi); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +($query) = $cgi->keywords; +if ( $query =~ /^(\d+)$/ ) { #editing $part_referral=qsearchs('part_referral',{'refnum'=>$1}); $action='Edit'; } else { #adding @@ -50,11 +54,13 @@ $p1 = popurl(1); print $cgi->header( '-expires' => 'now' ), header("$action Referral", menubar( 'Main Menu' => popurl(2), 'View all referrals' => popurl(2). "browse/part_referral.cgi", -)), <<END; - <FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST> -END +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -#display +print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!; print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!, "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)"; diff --git a/htdocs/edit/part_svc.cgi b/htdocs/edit/part_svc.cgi index 58a1e048e..8a39fc7a9 100755 --- a/htdocs/edit/part_svc.cgi +++ b/htdocs/edit/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_svc.cgi,v 1.7 1999-01-19 05:13:42 ivan Exp $ +# $Id: part_svc.cgi,v 1.8 1999-02-07 09:59:21 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -10,7 +10,10 @@ # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 # # $Log: part_svc.cgi,v $ -# Revision 1.7 1999-01-19 05:13:42 ivan +# Revision 1.8 1999-02-07 09:59:21 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:42 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -41,21 +44,31 @@ $cgi = new CGI; &cgisuidsetup($cgi); -($query) = $cgi->keywords; -if ( $query && $query =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $part_svc = new FS::part_svc ( { + map { $_, scalar($cgi->param($_)) } fields('part_svc') + } ); +} elsif ( $cgi->keywords ) { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; $part_svc=qsearchs('part_svc',{'svcpart'=>$1}); - $action='Edit'; } else { #adding $part_svc = new FS::part_svc {}; - $action='Add'; } +$action = $part_svc->svcpart ? 'Edit' : 'Add'; $hashref = $part_svc->hashref; $p = popurl(2); print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar( 'Main Menu' => $p, 'View all services' => "${p}browse/part_svc.cgi", -)), '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>'; +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>'; print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!, "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)"; diff --git a/htdocs/edit/process/cust_pkg.cgi b/htdocs/edit/process/cust_pkg.cgi index 639b2f140..2c5eaef97 100755 --- a/htdocs/edit/process/cust_pkg.cgi +++ b/htdocs/edit/process/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cust_pkg.cgi,v 1.4 1999-01-25 12:19:10 ivan Exp $ +# $Id: cust_pkg.cgi,v 1.5 1999-02-07 09:59:26 ivan Exp $ # # this is for changing packages around, not for editing things within the # package @@ -21,8 +21,8 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: cust_pkg.cgi,v $ -# Revision 1.4 1999-01-25 12:19:10 ivan -# yet more mod_perl stuff +# Revision 1.5 1999-02-07 09:59:26 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email # # Revision 1.3 1999/01/19 05:13:54 ivan # for mod_perl: no more top-level my() variables; use vars instead @@ -37,15 +37,15 @@ use vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(idiot popurl); +use FS::CGI qw(popurl); use FS::cust_pkg; $cgi = new CGI; # create form object - &cgisuidsetup($cgi); +$error = ''; #untaint custnum -$cgi->param('new_custnum') =~ /^(\d+)$/; +$cgi->param('custnum') =~ /^(\d+)$/; $custnum = $1; @remove_pkgnums = map { @@ -54,13 +54,18 @@ $custnum = $1; } $cgi->param('remove_pkg'); foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) { - my($num_pkgs)=$cgi->param("pkg$pkgpart"); - while ( $num_pkgs-- ) { - push @pkgparts,$pkgpart; + if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) { + my $num_pkgs = $1; + while ( $num_pkgs-- ) { + push @pkgparts,$pkgpart; + } + } else { + $error = "Illegal quantity"; + last; } } -$error = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); +$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); if ($error) { $cgi->param('error', $error); diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index 3ec31589a..adf4672bd 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_pkg.cgi,v 1.7 1999-01-19 05:13:55 ivan Exp $ +# $Id: part_pkg.cgi,v 1.8 1999-02-07 09:59:27 ivan Exp $ # # process/part_pkg.cgi: Edit package definitions (process form) # @@ -17,7 +17,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_pkg.cgi,v $ -# Revision 1.7 1999-01-19 05:13:55 ivan +# Revision 1.8 1999-02-07 09:59:27 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:55 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -38,11 +41,11 @@ # use strict; -use vars qw( $cgi $pkgpart $old $new $part_svc ); +use vars qw( $cgi $pkgpart $old $new $part_svc $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(eidiot popurl); +use FS::CGI qw(popurl); use FS::Record qw(qsearch qsearchs fields); use FS::part_pkg; use FS::pkg_svc; @@ -61,44 +64,55 @@ $new = new FS::part_pkg ( { } fields('part_pkg') } ); +#most of the stuff below should move to part_pkg.pm + +foreach $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + unless ( $quantity =~ /^(\d+)$/ ) { + $cgi->param('error', "Illegal quantity" ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; + } +} + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; +local $SIG{PIPE} = 'IGNORE'; if ( $pkgpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; - $pkgpart=$new->getfield('pkgpart'); + $error = $new->insert; + $pkgpart=$new->pkgpart; +} +if ( $error ) { + $cgi->param('error', $error ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; } foreach $part_svc (qsearch('part_svc',{})) { -# don't update non-changing records in part_svc (causing harmless but annoying -# "Records identical" errors). ivan@sisd.com 98-jan-19 - #my($quantity)=$cgi->param('pkg_svc'. $part_svc->getfield('svcpart')), - my($quantity)=$cgi->param('pkg_svc'. $part_svc->svcpart) || 0, - my($old_pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - }); - my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; next unless $old_quantity != $quantity; #!here - my($new_pkg_svc)=new FS::pkg_svc({ + my $new_pkg_svc = new FS::pkg_svc( { 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - #'quantity' => $cgi->param('pkg_svc'. $part_svc->getfield('svcpart')), + 'svcpart' => $part_svc->svcpart, 'quantity' => $quantity, - }); - if ($old_pkg_svc) { - my($error)=$new_pkg_svc->replace($old_pkg_svc); - eidiot($error) if $error; + } ); + if ( $old_pkg_svc ) { + my $myerror = $new_pkg_svc->replace($old_pkg_svc); + die $myerror if $myerror; } else { - my($error)=$new_pkg_svc->insert; - eidiot($error) if $error; + my $myerror = $new_pkg_svc->insert; + die $myerror if $myerror; } } @@ -109,8 +123,8 @@ unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { my %hash = $old_cust_pkg->hash; $hash{'pkgpart'} = $pkgpart; my($new_cust_pkg) = new FS::cust_pkg \%hash; - my $error = $new_cust_pkg->replace($old_cust_pkg); - eidiot "Error modifying cust_pkg record: $error\n" if $error; + my $myerror = $new_cust_pkg->replace($old_cust_pkg); + die "Error modifying cust_pkg record: $myerror\n" if $myerror; print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum); } diff --git a/htdocs/edit/process/part_referral.cgi b/htdocs/edit/process/part_referral.cgi index 9886015f9..cde27ede1 100755 --- a/htdocs/edit/process/part_referral.cgi +++ b/htdocs/edit/process/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_referral.cgi,v 1.5 1999-01-19 05:13:56 ivan Exp $ +# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_referral.cgi,v $ -# Revision 1.5 1999-01-19 05:13:56 ivan +# Revision 1.6 1999-02-07 09:59:28 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:56 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -25,13 +28,13 @@ # use strict; -use vars qw( $cgi $refnum $new ); +use vars qw( $cgi $refnum $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs fields); use FS::part_referral; -use FS::CGI qw(popurl eidiot); +use FS::CGI qw(popurl); $cgi = new CGI; &cgisuidsetup($cgi); @@ -45,15 +48,18 @@ $new = new FS::part_referral ( { } ); if ( $refnum ) { - my($old)=qsearchs('part_referral',{'refnum'=>$refnum}); - eidiot("(Old) Record not found!") unless $old; - my($error)=$new->replace($old); - eidiot($error) if $error; + my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } ); + die "(Old) Record not found!" unless $old; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; } +$refnum=$new->refnum; -$refnum=$new->getfield('refnum'); -print $cgi->redirect(popurl(3). "browse/part_referral.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/part_referral.cgi"); +} diff --git a/htdocs/edit/process/part_svc.cgi b/htdocs/edit/process/part_svc.cgi index e25192c1c..0b3e2cd1c 100755 --- a/htdocs/edit/process/part_svc.cgi +++ b/htdocs/edit/process/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_svc.cgi,v 1.6 1999-01-19 05:13:57 ivan Exp $ +# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_svc.cgi,v $ -# Revision 1.6 1999-01-19 05:13:57 ivan +# Revision 1.7 1999-02-07 09:59:29 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:57 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -28,13 +31,13 @@ # use strict; -use vars qw ( $cgi $svcpart $old $new ); +use vars qw ( $cgi $svcpart $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs fields); use FS::part_svc; -use FS::CGI qw(eidiot popurl); +use FS::CGI qw(popurl); $cgi = new CGI; &cgisuidsetup($cgi); @@ -51,13 +54,16 @@ $new = new FS::part_svc ( { } ); if ( $svcpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $svcpart=$new->getfield('svcpart'); } -print $cgi->redirect(popurl(3)."browse/part_svc.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3)."browse/part_svc.cgi"); +} diff --git a/htdocs/edit/process/svc_acct.cgi b/htdocs/edit/process/svc_acct.cgi index 7fd87ea84..ba231ece3 100755 --- a/htdocs/edit/process/svc_acct.cgi +++ b/htdocs/edit/process/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct.cgi,v 1.4 1999-01-19 05:13:58 ivan Exp $ +# $Id: svc_acct.cgi,v 1.5 1999-02-07 09:59:30 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi @@ -23,7 +23,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: svc_acct.cgi,v $ -# Revision 1.4 1999-01-19 05:13:58 ivan +# Revision 1.5 1999-02-07 09:59:30 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:58 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -35,11 +38,11 @@ # use strict; -use vars qw( $cgi $svcnum $old $new ); +use vars qw( $cgi $svcnum $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(eidiot popurl); +use FS::CGI qw(popurl); use FS::Record qw(qsearchs fields); use FS::svc_acct; @@ -68,15 +71,16 @@ $new = new FS::svc_acct ( { } ); if ( $svcnum ) { - my($error) = $new->replace($old); - &eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error) = $new->insert; - &eidiot($error) if $error; - $svcnum = $new->getfield('svcnum'); + $error = $new->insert; + $svcnum = $new->svcnum; } -#no errors, view account -print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); - +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); +} diff --git a/htdocs/edit/process/svc_acct_pop.cgi b/htdocs/edit/process/svc_acct_pop.cgi index 414c6fb28..763bca4a8 100755 --- a/htdocs/edit/process/svc_acct_pop.cgi +++ b/htdocs/edit/process/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_pop.cgi,v 1.5 1999-01-19 05:13:59 ivan Exp $ +# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: svc_acct_pop.cgi,v $ -# Revision 1.5 1999-01-19 05:13:59 ivan +# Revision 1.6 1999-02-07 09:59:31 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:59 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -25,13 +28,13 @@ # use strict; -use vars qw( $cgi $popnum $old $new ); +use vars qw( $cgi $popnum $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs fields); use FS::svc_acct_pop; -use FS::CGI qw(popurl eidiot); +use FS::CGI qw(popurl); $cgi = new CGI; # create form object @@ -48,12 +51,16 @@ $new = new FS::svc_acct_pop ( { } ); if ( $popnum ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $popnum=$new->getfield('popnum'); } -print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi"); + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi"); +} diff --git a/htdocs/edit/process/svc_acct_sm.cgi b/htdocs/edit/process/svc_acct_sm.cgi index 53650c888..5fefeafdb 100755 --- a/htdocs/edit/process/svc_acct_sm.cgi +++ b/htdocs/edit/process/svc_acct_sm.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_sm.cgi,v 1.4 1999-01-19 05:14:00 ivan Exp $ +# $Id: svc_acct_sm.cgi,v 1.5 1999-02-07 09:59:32 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct_sm.cgi @@ -24,7 +24,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: svc_acct_sm.cgi,v $ -# Revision 1.4 1999-01-19 05:14:00 ivan +# Revision 1.5 1999-02-07 09:59:32 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:00 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -42,6 +45,7 @@ use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs fields); use FS::svc_acct_sm; +use FS::CGI qw(popurl); $cgi = new CGI; cgisuidsetup($cgi); @@ -52,14 +56,14 @@ $svcnum =$1; $old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; #unmunge domsvc and domuid -$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); -$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); +#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); +#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); $new = new FS::svc_acct_sm ( { map { ($_, scalar($cgi->param($_))); #} qw(svcnum pkgnum svcpart domuser domuid domsvc) - } ( fields('svc_acct_sm'), qw( pkgnum svcpart) ) + } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) ) } ); if ( $svcnum ) { @@ -69,9 +73,10 @@ if ( $svcnum ) { $svcnum = $new->getfield('svcnum'); } -unless ($error) { - print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string ); } else { - idiot($error); + print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum"); } diff --git a/htdocs/edit/process/svc_domain.cgi b/htdocs/edit/process/svc_domain.cgi index 4c96823e2..fe3c6f7a1 100755 --- a/htdocs/edit/process/svc_domain.cgi +++ b/htdocs/edit/process/svc_domain.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_domain.cgi,v 1.4 1999-01-19 05:14:01 ivan Exp $ +# $Id: svc_domain.cgi,v 1.5 1999-02-07 09:59:33 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi @@ -20,7 +20,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: svc_domain.cgi,v $ -# Revision 1.4 1999-01-19 05:14:01 ivan +# Revision 1.5 1999-02-07 09:59:33 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:01 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -36,8 +39,9 @@ use vars qw( $cgi $svcnum $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearchs fields); use FS::svc_domain; +use FS::CGI qw(popurl); #remove this to actually test the domains! $FS::svc_domain::whois_hack = 1; @@ -66,9 +70,10 @@ if ($cgi->param('legal') ne "Yes") { $svcnum=$new->svcnum; } -unless ($error) { - print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string ); } else { - idiot($error); + print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); } diff --git a/htdocs/edit/svc_acct.cgi b/htdocs/edit/svc_acct.cgi index af18654ac..876d7be5a 100755 --- a/htdocs/edit/svc_acct.cgi +++ b/htdocs/edit/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct.cgi,v 1.6 1999-01-19 05:13:43 ivan Exp $ +# $Id: svc_acct.cgi,v 1.7 1999-02-07 09:59:22 ivan Exp $ # # Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} @@ -18,7 +18,10 @@ # use conf/shells and dbdef username length ivan@sisd.com 98-jul-13 # # $Log: svc_acct.cgi,v $ -# Revision 1.6 1999-01-19 05:13:43 ivan +# Revision 1.7 1999-02-07 09:59:22 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:43 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -35,7 +38,7 @@ use strict; use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart - $part_svc $query $svc $otaker $username $password $ulen $ulen2 $p1 + $part_svc $svc $otaker $username $password $ulen $ulen2 $p1 $popnum $uid $gid $finger $dir $shell $quota $slipip ); use CGI; use CGI::Carp qw(fatalsToBrowser); @@ -51,57 +54,64 @@ $cgi = new CGI; $conf = new FS::Conf; @shells = $conf->config('shells'); -($query) = $cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; - - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; - +if ( $cgi->param('error') ) { + $svc_acct = new FS::svc_acct ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct') + } ); + $svcnum = $svc_acct->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct) svcnum!"; - $action="Edit"; - -} else { #adding + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $svc_acct = new FS::svc_acct({}); + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - foreach $_ (split(/-/,$query)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $svcnum=''; + } else { #adding - #set gecos - my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); - if ($cust_pkg) { - my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } ); - $svc_acct->setfield('finger', - $cust_main->getfield('first') . " " . $cust_main->getfield('last') - ) ; - } + $svc_acct = new FS::svc_acct({}); - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct') ) { - if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) { - $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) ); + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + $svcnum=''; + + #set gecos + my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); + if ($cust_pkg) { + my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } ); + $svc_acct->setfield('finger', + $cust_main->getfield('first') . " " . $cust_main->getfield('last') + ) ; } - } - $action="Add"; + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct') ) { + if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) { + $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) ); + } + } + } } +$action = $svcnum ? 'Edit' : 'Add'; $svc = $part_svc->getfield('svc'); @@ -116,7 +126,13 @@ $ulen = $svc_acct->dbdef_table->column('username')->length; $ulen2 = $ulen+2; $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("$action $svc account"), <<END; +print $cgi->header( '-expires' => 'now' ), header("$action $svc account"); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> diff --git a/htdocs/edit/svc_acct_pop.cgi b/htdocs/edit/svc_acct_pop.cgi index 115c46745..41a163ebb 100755 --- a/htdocs/edit/svc_acct_pop.cgi +++ b/htdocs/edit/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_pop.cgi,v 1.6 1999-01-19 05:13:44 ivan Exp $ +# $Id: svc_acct_pop.cgi,v 1.7 1999-02-07 09:59:23 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -10,7 +10,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: svc_acct_pop.cgi,v $ -# Revision 1.6 1999-01-19 05:13:44 ivan +# Revision 1.7 1999-02-07 09:59:23 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:44 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -34,31 +37,39 @@ use vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::svc_acct_pop; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); $cgi = new CGI; &cgisuidsetup($cgi); -($query)=$cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $svc_acct_pop = new FS::svc_acct_pop ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop') + } ); +} elsif ( $cgi->keywords ) { #editing + my($query)=$cgi->keywords; + $query =~ /^(\d+)$/; $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1}); - $action='Edit'; } else { #adding $svc_acct_pop = new FS::svc_acct_pop {}; - $action='Add'; } +$action = $svc_acct_pop->popnum ? 'Edit' : 'Add'; $hashref = $svc_acct_pop->hashref; $p1 = popurl(1); print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar( 'Main Menu' => popurl(2), 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi", -)), <<END; - <FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST> -END +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!; #display @@ -68,7 +79,7 @@ print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!, print <<END; <PRE> City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}"> -State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 VALUE="$hashref->{state}"> +State <INPUT TYPE="text" NAME="state" SIZE=16 MAXLENGTH=16 VALUE="$hashref->{state}"> Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}"> Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}"> </PRE> diff --git a/htdocs/edit/svc_acct_sm.cgi b/htdocs/edit/svc_acct_sm.cgi index 0de4fa1ac..d68d67c3a 100755 --- a/htdocs/edit/svc_acct_sm.cgi +++ b/htdocs/edit/svc_acct_sm.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_sm.cgi,v 1.7 1999-01-19 05:13:45 ivan Exp $ +# $Id: svc_acct_sm.cgi,v 1.8 1999-02-07 09:59:24 ivan Exp $ # # Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} @@ -35,7 +35,10 @@ # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26 # # $Log: svc_acct_sm.cgi,v $ -# Revision 1.7 1999-01-19 05:13:45 ivan +# Revision 1.8 1999-02-07 09:59:24 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:45 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -73,49 +76,55 @@ $cgi = new CGI; $conf = new FS::Conf; $mydomain = $conf->config('domain'); - -($query) = $cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct_sm) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; - - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; - +if ( $cgi->param('error') ) { + $svc_acct_sm = new FS::svc_acct_sm ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm') + } ); + $svcnum = $svc_acct_sm->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct_sm) svcnum!"; - $action="Edit"; - -} else { #adding + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $svc_acct_sm = new FS::svc_acct_sm({}); + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + } else { #adding - $svcnum=''; + $svc_acct_sm = new FS::svc_acct_sm({}); - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct_sm') ) { - if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { - $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; } - } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $action='Add'; + $svcnum=''; + + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct_sm') ) { + if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { + $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + } + } + } } +$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add'; if ($pkgnum) { @@ -175,9 +184,13 @@ if ($pkgnum) { } $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", ''), <<END; - <FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST> -END +print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST>!; #display @@ -206,14 +219,16 @@ print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * #domsvc print qq! \@ <SELECT NAME="domsvc" SIZE=1>!; foreach $_ (keys %domain) { - print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}"; + print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", + qq! VALUE="$_">$domain{$_}!; } print "</SELECT>"; #uid print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!; foreach $_ (keys %username) { - print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}"; + print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", + qq! VALUE="$_">$username{$_}!; } print "</SELECT>\@$mydomain mailbox."; diff --git a/htdocs/edit/svc_domain.cgi b/htdocs/edit/svc_domain.cgi index 45ff8bb6c..05cabba2b 100755 --- a/htdocs/edit/svc_domain.cgi +++ b/htdocs/edit/svc_domain.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_domain.cgi,v 1.7 1999-01-19 05:13:46 ivan Exp $ +# $Id: svc_domain.cgi,v 1.8 1999-02-07 09:59:25 ivan Exp $ # # Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart} @@ -17,7 +17,10 @@ # no GOV in instructions ivan@sisd.com 98-jul-17 # # $Log: svc_domain.cgi,v $ -# Revision 1.7 1999-01-19 05:13:46 ivan +# Revision 1.8 1999-02-07 09:59:25 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:46 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -41,7 +44,7 @@ use strict; use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc - $query $svc $otaker $domain $p1 ); + $svc $otaker $domain $p1 $kludge_action $purpose ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); @@ -52,48 +55,59 @@ use FS::svc_domain; $cgi = new CGI; &cgisuidsetup($cgi); -($query) = $cgi->keywords; -if ( $query =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) - or die "Unknown (svc_domain) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +if ( $cgi->param('error') ) { + $svc_domain = new FS::svc_domain ( { + map { $_, scalar($cgi->param($_)) } fields('svc_domain') + } ); + $svcnum = $svc_domain->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); + $kludge_action = $cgi->param('action'); + $purpose = $cgi->param('purpose'); + $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); + die "No part_svc entry!" unless $part_svc; +} else { + $kludge_action = ''; + $purpose = ''; + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) + or die "Unknown (svc_domain) svcnum!"; - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $action="Edit"; + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; -} else { #adding + } else { #adding - $svc_domain = new FS::svc_domain({}); + $svc_domain = new FS::svc_domain({}); - foreach $_ (split(/-/,$query)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $svcnum=''; + $svcnum=''; - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_domain') ) { - if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { - $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_domain') ) { + if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { + $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + } } - } - - $action="Add"; + } } +$action = $svcnum ? 'Edit' : 'Add'; $svc = $part_svc->getfield('svc'); @@ -102,20 +116,33 @@ $otaker = getotaker; $domain = $svc_domain->domain; $p1 = popurl(1); -print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''), <<END; +print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> - <INPUT TYPE="radio" NAME="action" VALUE="N">New - <BR><INPUT TYPE="radio" NAME="action" VALUE="M">Transfer +END + +print qq!<INPUT TYPE="radio" NAME="action" VALUE="N"!; +print ' CHECKED' if $kludge_action eq 'N'; +print qq!>New!; +print qq!<BR><INPUT TYPE="radio" NAME="action" VALUE="M"!; +print ' CHECKED' if $kludge_action eq 'M'; +print qq!>Transfer!; +print <<END; <P>Customer agrees to be bound by NSI's <A HREF="http://rs.internic.net/help/agreement.txt"> Domain Name Registration Agreement</A> <SELECT NAME="legal" SIZE=1><OPTION SELECTED>No<OPTION>Yes</SELECT> <P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26> -<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="" SIZE=64> +<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="$purpose" SIZE=64> <P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER> <UL> <LI>COM is for commercial, for-profit organziations diff --git a/htdocs/misc/cancel-unaudited.cgi b/htdocs/misc/cancel-unaudited.cgi index b8729440f..d54674660 100755 --- a/htdocs/misc/cancel-unaudited.cgi +++ b/htdocs/misc/cancel-unaudited.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cancel-unaudited.cgi,v 1.4 1999-01-19 05:14:03 ivan Exp $ +# $Id: cancel-unaudited.cgi,v 1.5 1999-02-07 09:59:34 ivan Exp $ # # Usage: cancel-unaudited.cgi svcnum # http://server.name/path/cancel-unaudited.cgi pkgnum @@ -18,7 +18,10 @@ # bmccane@maxbaud.net 98-apr-3 # # $Log: cancel-unaudited.cgi,v $ -# Revision 1.4 1999-01-19 05:14:03 ivan +# Revision 1.5 1999-02-07 09:59:34 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:03 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -48,7 +51,7 @@ $query =~ /^(\d+)$/; $svcnum = $1; $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum}); -&eidiot("Unknown svcnum!") unless $svc_acct; +die "Unknown svcnum!" unless $svc_acct; $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); &eidiot(qq!This account has already been audited. Cancel the @@ -70,5 +73,5 @@ $error = $svc_acct->delete; $error = $cust_svc->delete; &eidiot($error) if $error; -$cgi->redirect(popurl(2)); +print $cgi->redirect(popurl(2)); diff --git a/htdocs/misc/process/link.cgi b/htdocs/misc/process/link.cgi index c20b47373..808299415 100755 --- a/htdocs/misc/process/link.cgi +++ b/htdocs/misc/process/link.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: link.cgi,v 1.3 1999-01-19 05:14:10 ivan Exp $ +# $Id: link.cgi,v 1.4 1999-02-07 09:59:35 ivan Exp $ # # ivan@voicenet.com 97-feb-5 # @@ -12,7 +12,10 @@ # can also link on some other fields now (about time) ivan@sisd.com 98-jun-24 # # $Log: link.cgi,v $ -# Revision 1.3 1999-01-19 05:14:10 ivan +# Revision 1.4 1999-02-07 09:59:35 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.3 1999/01/19 05:14:10 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -24,7 +27,7 @@ use strict; use vars qw ( $cgi $old $new $error ); use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::CGI qw(popurlidiot); +use FS::CGI qw(popurl idiot); use FS::UID qw(cgisuidsetup); use FS::cust_svc; use FS::Record qw(qsearchs); @@ -41,7 +44,7 @@ unless ( $svcnum ) { my($svcdb) = $part_svc->getfield('svcdb'); $cgi->param('link_field') =~ /^(\w+)$/; my($link_field)=$1; my($svc_acct)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') }); - idiot("$link_field not found!") unless $svc_acct; + eidiot("$link_field not found!") unless $svc_acct; $svcnum=$svc_acct->svcnum; } diff --git a/htdocs/search/cust_main.cgi b/htdocs/search/cust_main.cgi index 55139e9a8..ed7b71425 100755 --- a/htdocs/search/cust_main.cgi +++ b/htdocs/search/cust_main.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cust_main.cgi,v 1.7 1999-01-25 12:19:11 ivan Exp $ +# $Id: cust_main.cgi,v 1.8 1999-02-07 09:59:36 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_main.cgi @@ -19,7 +19,10 @@ # display total, use FS::CGI ivan@sisd.com 98-jul-17 # # $Log: cust_main.cgi,v $ -# Revision 1.7 1999-01-25 12:19:11 ivan +# Revision 1.8 1999-02-07 09:59:36 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/25 12:19:11 ivan # yet more mod_perl stuff # # Revision 1.6 1999/01/19 05:14:12 ivan @@ -52,7 +55,7 @@ use IO::Handle; use String::Approx qw(amatch); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar idiot popurl table); +use FS::CGI qw(header menubar eidiot popurl table); use FS::cust_main; $cgi = new CGI; @@ -83,8 +86,7 @@ if ( scalar(@cust_main) == 1 ) { print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum); exit; } elsif ( scalar(@cust_main) == 0 ) { - idiot "No matching customers found!\n"; - exit; + eidiot "No matching customers found!\n"; } else { my($total)=scalar(@cust_main); @@ -156,7 +158,6 @@ END print <<END; </TABLE> - </CENTER> </BODY> </HTML> END @@ -183,7 +184,7 @@ sub cardsearch { my($card)=$cgi->param('card'); $card =~ s/\D//g; - $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; }; + $card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n"; my($payinfo)=$1; push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'}); @@ -197,7 +198,7 @@ sub lastsearch { } $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/ - or do { idiot "Illegal last name"; exit; }; + or eidiot "Illegal last name"; my($last)=$1; if ( $last_type{'Exact'} @@ -237,7 +238,7 @@ sub companysearch { }; $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/ - or do { idiot "Illegal company"; exit; }; + or eidiot "Illegal company"; my($company)=$1; if ( $company_type{'Exact'} diff --git a/htdocs/search/cust_pkg.cgi b/htdocs/search/cust_pkg.cgi index 6685aea70..b7afc62a5 100755 --- a/htdocs/search/cust_pkg.cgi +++ b/htdocs/search/cust_pkg.cgi @@ -1,11 +1,14 @@ #!/usr/bin/perl -Tw # -# $Id: cust_pkg.cgi,v 1.6 1999-01-19 05:14:13 ivan Exp $ +# $Id: cust_pkg.cgi,v 1.7 1999-02-07 09:59:37 ivan Exp $ # # based on search/svc_acct.cgi ivan@sisd.com 98-jul-17 # # $Log: cust_pkg.cgi,v $ -# Revision 1.6 1999-01-19 05:14:13 ivan +# Revision 1.7 1999-02-07 09:59:37 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:14:13 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -29,7 +32,11 @@ use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot popurl); +use FS::CGI qw(header eidiot popurl); +use FS::cust_pkg; +use FS::pkg_svc; +use FS::cust_svc; +use FS::cust_main; $cgi = new CGI; &cgisuidsetup($cgi); @@ -71,8 +78,7 @@ if ( scalar(@cust_pkg) == 1 ) { print $cgi->redirect(popurl(2). "view/cust_pkg.cgi?$pkgnum"); exit; } elsif ( scalar(@cust_pkg) == 0 ) { #error - &idiot("No packages found"); - exit; + eidiot("No packages found"); } else { my($total)=scalar(@cust_pkg); print $cgi->header( '-expires' => 'now' ), header('Package Search Results',''), <<END; @@ -110,7 +116,6 @@ END print <<END; </TABLE> - </CENTER> </BODY> </HTML> END diff --git a/htdocs/search/svc_acct.cgi b/htdocs/search/svc_acct.cgi index f3305080b..93b03e56d 100755 --- a/htdocs/search/svc_acct.cgi +++ b/htdocs/search/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct.cgi,v 1.6 1999-01-19 05:14:14 ivan Exp $ +# $Id: svc_acct.cgi,v 1.7 1999-02-07 09:59:38 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi @@ -23,7 +23,10 @@ # give service and customer info too ivan@sisd.com 98-aug-16 # # $Log: svc_acct.cgi,v $ -# Revision 1.6 1999-01-19 05:14:14 ivan +# Revision 1.7 1999-02-07 09:59:38 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:14:14 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -47,7 +50,7 @@ use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot popurl); +use FS::CGI qw(header eidiot popurl); use FS::svc_acct; use FS::cust_main; @@ -93,8 +96,7 @@ if ( scalar(@svc_acct) == 1 ) { print $cgi->redirect(popurl(2). "view/svc_acct.cgi?$svcnum"); #redirect exit; } elsif ( scalar(@svc_acct) == 0 ) { #error - idiot("Account not found"); - exit; + eidiot("Account not found"); } else { my($total)=scalar(@svc_acct); print $cgi->header( '-expires' => 'now' ), header("Account Search Results",''), <<END; diff --git a/htdocs/search/svc_domain.cgi b/htdocs/search/svc_domain.cgi index cb704a3c4..732265210 100755 --- a/htdocs/search/svc_domain.cgi +++ b/htdocs/search/svc_domain.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_domain.cgi,v 1.4 1999-01-19 05:14:17 ivan Exp $ +# $Id: svc_domain.cgi,v 1.5 1999-02-07 09:59:39 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi @@ -17,7 +17,10 @@ # display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17 # # $Log: svc_domain.cgi,v $ -# Revision 1.4 1999-01-19 05:14:17 ivan +# Revision 1.5 1999-02-07 09:59:39 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:17 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -34,7 +37,7 @@ use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot popurl); +use FS::CGI qw(header eidiot popurl); $cgi = new CGI; &cgisuidsetup($cgi); @@ -68,8 +71,7 @@ if ( scalar(@svc_domain) == 1 ) { print $cgi->redirect(popurl(2). "view/svc_domain.cgi?". $svc_domain[0]->svcnum); exit; } elsif ( scalar(@svc_domain) == 0 ) { - idiot "No matching domains found!\n"; - exit; + eidiot "No matching domains found!\n"; } else { CGI::Base::SendHeaders(); # one guess diff --git a/htdocs/view/cust_main.cgi b/htdocs/view/cust_main.cgi index 2119b3e0c..7d51e288a 100755 --- a/htdocs/view/cust_main.cgi +++ b/htdocs/view/cust_main.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: cust_main.cgi,v 1.11 1999-01-25 12:26:04 ivan Exp $ +# $Id: cust_main.cgi,v 1.12 1999-02-07 09:59:40 ivan Exp $ # # Usage: cust_main.cgi custnum # http://server.name/path/cust_main.cgi?custnum @@ -33,7 +33,10 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: cust_main.cgi,v $ -# Revision 1.11 1999-01-25 12:26:04 ivan +# Revision 1.12 1999-02-07 09:59:40 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.11 1999/01/25 12:26:04 ivan # yet more mod_perl stuff # # Revision 1.10 1999/01/19 05:14:19 ivan @@ -182,7 +185,7 @@ print "Billing information (", ( grep { $_ eq 'POST' } @invoicing_list ) ? 'yes' : 'no', '</TD></TR>', '<TR><TD ALIGN="right">Email invoices</TD><TD BGCOLOR="#ffffff">', - join(', ', grep { $_ ne 'POST' } @invoicing_list ), + join(', ', grep { $_ ne 'POST' } @invoicing_list ) || 'no', '</TD></TR>', '<TR><TD ALIGN="right">Billing type</TD><TD BGCOLOR="#ffffff">', ; @@ -219,7 +222,7 @@ print "</TABLE></TD></TR></TABLE></TD></TR></TABLE>"; print qq!<BR><BR><A NAME="cust_pkg">Packages</A> !, # qq!<BR>Click on package number to view/edit package.!, - qq!( <A HREF="!, popurl(2), qq!/edit/cust_pkg.cgi?$custnum">Order and cancel packages</A> )!, + qq!( <A HREF="!, popurl(2), qq!edit/cust_pkg.cgi?$custnum">Order and cancel packages</A> )!, ; #display packages @@ -239,7 +242,7 @@ print qq!!, table, "\n", @packages = $cust_main->all_pkgs; #@packages = $cust_main->ncancelled_pkgs; -$n1 = ''; +$n1 = '<TR>'; foreach $package (@packages) { my $pkgnum = $package->pkgnum; my $pkg = $package->part_pkg->pkg; @@ -258,7 +261,7 @@ foreach $package (@packages) { qq!<TD ROWSPAN=$rowspan><FONT SIZE=-1>!, #qq!<A HREF="$pkgview">$pkg - $comment</A>!, qq!$pkg - $comment!, - qq! ( <A HREF="$pkgview">Edit</A> | <A HREF="$button_url">Customize pricing</A>)</FONT></TD>!, + qq! ( <A HREF="$pkgview">Edit</A> | <A HREF="$button_url">Customize pricing</A> )</FONT></TD>!, ; for ( qw( setup bill susp expire cancel ) ) { print "<TD ROWSPAN=$rowspan><FONT SIZE=-1>", ( $package->getfield($_) diff --git a/htdocs/view/svc_acct_sm.cgi b/htdocs/view/svc_acct_sm.cgi index 80bd48967..24c78ad18 100755 --- a/htdocs/view/svc_acct_sm.cgi +++ b/htdocs/view/svc_acct_sm.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: svc_acct_sm.cgi,v 1.6 1999-01-19 05:14:22 ivan Exp $ +# $Id: svc_acct_sm.cgi,v 1.7 1999-02-07 09:59:42 ivan Exp $ # # Usage: svc_acct_sm.cgi svcnum # http://server.name/path/svc_acct_sm.cgi?svcnum @@ -22,7 +22,10 @@ # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17 # # $Log: svc_acct_sm.cgi,v $ -# Revision 1.6 1999-01-19 05:14:22 ivan +# Revision 1.7 1999-02-07 09:59:42 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:14:22 ivan # for mod_perl: no more top-level my() variables; use vars instead # also the last s/create/new/; # @@ -42,7 +45,7 @@ use strict; use vars qw($conf $cgi $mydomain $query $svcnum $svc_acct_sm $cust_svc - $pkgnum cust_pkg $custnum $part_svc $p $domsvc,$domuid,$domuser + $pkgnum $cust_pkg $custnum $part_svc $p $domsvc $domuid $domuser $svc $svc_domain $domain $svc_acct $username ); use CGI; use FS::UID qw(cgisuidsetup); @@ -68,6 +71,9 @@ $pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); +} else { + $cust_pkg = ''; + $custnum = ''; } $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); @@ -88,10 +94,9 @@ END } print <<END; - <A HREF="${p}">Main menu</A></CENTER><BR< - <FONT SIZE=+1>Service #$svcnum</FONT> + <A HREF="${p}">Main menu</A></CENTER><BR> + Service #$svcnum <P><A HREF="${p}edit/svc_acct_sm.cgi?$svcnum">Edit this information</A> - <BASEFONT SIZE=3> END ($domsvc,$domuid,$domuser) = ( @@ -106,17 +111,15 @@ $svc_acct = qsearchs('svc_acct',{'uid'=>$domuid}); $username = $svc_acct->username; #formatting -print qq!<HR>!; +print qq!<BR><BR>!; #svc print "Service: <B>$svc</B>"; -print "<HR>"; +print "<BR><BR>"; print qq!Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!; -print "<HR>"; - #formatting print <<END; diff --git a/site_perl/CGI.pm b/site_perl/CGI.pm index 142438e4c..723d7f4ec 100644 --- a/site_perl/CGI.pm +++ b/site_perl/CGI.pm @@ -171,7 +171,7 @@ sub itable { if ( $col ) { qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!; } else { - qq!<TABLE BORDER=0 $cellspacing=$cellspacing WIDTH="100%">!; + qq!<TABLE BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!; } } @@ -216,7 +216,10 @@ lose the background, eidiot ivan@sisd.com 98-sep-2 pod ivan@sisd.com 98-sep-12 $Log: CGI.pm,v $ -Revision 1.16 1999-01-25 12:26:05 ivan +Revision 1.17 1999-02-07 09:59:43 ivan +more mod_perl fixes, and bugfixes Peter Wemm sent via email + +Revision 1.16 1999/01/25 12:26:05 ivan yet more mod_perl stuff Revision 1.15 1999/01/18 09:41:48 ivan diff --git a/site_perl/part_svc.pm b/site_perl/part_svc.pm index fa3462350..6b3ba3d9f 100644 --- a/site_perl/part_svc.pm +++ b/site_perl/part_svc.pm @@ -82,7 +82,7 @@ returns the error, otherwise returns false. =cut sub replace { - my ( $new, $old ) = shift, shift; + my ( $new, $old ) = ( shift, shift ); return "Can't change svcdb!" unless $old->svcdb eq $new->svcdb; @@ -144,7 +144,7 @@ sub check { =head1 VERSION -$Id: part_svc.pm,v 1.2 1998-12-29 11:59:50 ivan Exp $ +$Id: part_svc.pm,v 1.3 1999-02-07 09:59:44 ivan Exp $ =head1 BUGS @@ -169,7 +169,10 @@ ivan@sisd.com 97-dec-6 pod ivan@sisd.com 98-sep-21 $Log: part_svc.pm,v $ -Revision 1.2 1998-12-29 11:59:50 ivan +Revision 1.3 1999-02-07 09:59:44 ivan +more mod_perl fixes, and bugfixes Peter Wemm sent via email + +Revision 1.2 1998/12/29 11:59:50 ivan mostly properly OO, some work still to be done with svc_ stuff |