diff options
Diffstat (limited to 'htdocs')
105 files changed, 5061 insertions, 2622 deletions
diff --git a/htdocs/.htaccess b/htdocs/.htaccess new file mode 100644 index 000000000..f8c6b9c0c --- /dev/null +++ b/htdocs/.htaccess @@ -0,0 +1,3 @@ +AuthName Freeside +AuthType Basic +require valid-user diff --git a/htdocs/browse/agent.cgi b/htdocs/browse/agent.cgi index cf5f2281f..b73d17b76 100755 --- a/htdocs/browse/agent.cgi +++ b/htdocs/browse/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: browse agent +# $Id: agent.cgi,v 1.13 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -13,36 +13,93 @@ # agent type was linking to wrong cgi ivan@sisd.com 98-jul-18 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent.cgi,v $ +# Revision 1.13 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.12 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.11 1999/01/20 09:43:16 ivan +# comment out future UI code (but look at it, it's neat!) +# +# Revision 1.10 1999/01/19 05:13:24 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.9 1999/01/18 09:41:14 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.8 1999/01/18 09:22:26 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.7 1998/12/17 05:25:16 ivan +# fix visual and other bugs +# +# Revision 1.6 1998/11/23 05:29:46 ivan +# use CGI::Carp +# +# Revision 1.5 1998/11/23 05:27:31 ivan +# to eliminate warnings +# +# Revision 1.4 1998/11/20 08:50:36 ivan +# s/CGI::Base/CGI.pm, visual fixes +# +# Revision 1.3 1998/11/08 10:11:02 ivan +# CGI.pm +# +# Revision 1.2 1998/11/07 10:24:22 ivan +# don't use depriciated FS::Bill and FS::Invoice, other miscellania +# use strict; -use CGI::Base; +use vars qw( $ui $cgi $p $agent ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar table popurl); +use FS::agent; +use FS::agent_type; + +#Begin silliness +# +#use FS::UI::CGI; +#use FS::UI::agent; +# +#$ui = new FS::UI::agent; +#$ui->browse; +#exit; +#__END__ +#End silliness -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header('Agent Listing', menubar( - 'Main Menu' => '../', - 'Add new agent' => '../edit/agent.cgi' +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('Agent Listing', menubar( + 'Main Menu' => $p, + 'Agent Types' => $p. 'browse/agent_type.cgi', +# 'Add new agent' => '../edit/agent.cgi' )), <<END; - <BR> - Click on agent number to edit. - <TABLE BORDER> +Agents are resellers of your service. Agents may be limited to a subset of your +full offerings (via their type).<BR><BR> +END +print &table(), <<END; <TR> - <TH><FONT SIZE=-1>Agent #</FONT></TH> - <TH>Agent</TH> + <TH COLSPAN=2>Agent</TH> <TH>Type</TH> <TH><FONT SIZE=-1>Freq. (unimp.)</FONT></TH> <TH><FONT SIZE=-1>Prog. (unimp.)</FONT></TH> </TR> END +# <TH><FONT SIZE=-1>Agent #</FONT></TH> +# <TH>Agent</TH> -my($agent); foreach $agent ( sort { $a->getfield('agentnum') <=> $b->getfield('agentnum') } qsearch('agent',{}) ) { @@ -52,10 +109,11 @@ foreach $agent ( sort { my($atype)=$agent_type->getfield('atype'); print <<END; <TR> - <TD><A HREF="../edit/agent.cgi?$hashref->{agentnum}"> + <TD><A HREF="${p}edit/agent.cgi?$hashref->{agentnum}"> $hashref->{agentnum}</A></TD> - <TD>$hashref->{agent}</TD> - <TD><A HREF="../edit/agent_type.cgi?$typenum">$atype</A></TD> + <TD><A HREF="${p}edit/agent.cgi?$hashref->{agentnum}"> + $hashref->{agent}</A></TD> + <TD><A HREF="${p}edit/agent_type.cgi?$typenum">$atype</A></TD> <TD>$hashref->{freq}</TD> <TD>$hashref->{prog}</TD> </TR> @@ -64,8 +122,12 @@ END } print <<END; + <TR> + <TD COLSPAN=2><A HREF="${p}edit/agent.cgi"><I>Add new agent</I></A></TD> + <TD><A HREF="${p}edit/agent_type.cgi"><I>Add new agent type</I></A></TD> + </TR> </TABLE> - </CENTER> + </BODY> </HTML> END diff --git a/htdocs/browse/agent_type.cgi b/htdocs/browse/agent_type.cgi index 5f05bd514..9d8687299 100755 --- a/htdocs/browse/agent_type.cgi +++ b/htdocs/browse/agent_type.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent_type.cgi: browse agent_type +# $Id: agent_type.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-10 # @@ -9,34 +9,58 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent_type.cgi,v $ +# Revision 1.8 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.7 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.6 1999/04/07 11:10:46 ivan +# harmless typo +# +# Revision 1.5 1999/01/19 05:13:25 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:15 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 05:25:17 ivan +# fix visual and other bugs +# +# Revision 1.2 1998/11/21 07:39:52 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $p $agent_type ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::agent_type; +use FS::type_pkgs; +use FS::part_pkg; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -print header("Agent Type Listing", menubar( - 'Main Menu' => '../', - 'Add new agent type' => "../edit/agent_type.cgi", -)), <<END; - <BR>Click on agent type number to edit. - <TABLE BORDER> +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("Agent Type Listing", menubar( + 'Main Menu' => $p, +)), "Agent types define groups of packages that you can then assign to". + " particular agents.<BR><BR>", &table(), <<END; <TR> - <TH><FONT SIZE=-1>Type #</FONT></TH> - <TH>Type</TH> - <TH colspan="2">Packages</TH> + <TH COLSPAN=2>Agent Type</TH> + <TH COLSPAN="2">Packages</TH> </TR> END -my($agent_type); foreach $agent_type ( sort { $a->getfield('typenum') <=> $b->getfield('typenum') } qsearch('agent_type',{}) ) { @@ -46,10 +70,10 @@ foreach $agent_type ( sort { $rowspan = int($rowspan/2+0.5) ; print <<END; <TR> - <TD ROWSPAN=$rowspan><A HREF="../edit/agent_type.cgi?$hashref->{typenum}"> + <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}"> $hashref->{typenum} </A></TD> - <TD ROWSPAN=$rowspan>$hashref->{atype}</TD> + <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">$hashref->{atype}</A></TD> END my($type_pkgs); @@ -59,7 +83,7 @@ END my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart }); print qq!<TR>! if ($tdcount == 0) ; $tdcount = 0 if ($tdcount == -1) ; - print qq!<TD><A HREF="../edit/part_pkg.cgi?$pkgpart">!, + print qq!<TD><A HREF="${p}edit/part_pkg.cgi?$pkgpart">!, $part_pkg->getfield('pkg'),"</A></TD>"; $tdcount ++ ; if ($tdcount == 2) @@ -73,8 +97,8 @@ END } print <<END; - </TR></TABLE> - </CENTER> + <TR><TD COLSPAN=2><I><A HREF="${p}edit/agent_type.cgi">Add new agent type</A></I></TD></TR> + </TABLE> </BODY> </HTML> END diff --git a/htdocs/browse/cust_main_county.cgi b/htdocs/browse/cust_main_county.cgi index d615198c9..5f2b13dc0 100755 --- a/htdocs/browse/cust_main_county.cgi +++ b/htdocs/browse/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county.cgi: browse cust_main_county +# $Id: cust_main_county.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-13 # @@ -8,46 +8,85 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.7 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.6 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.5 1999/01/19 05:13:26 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:16 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 05:25:18 ivan +# fix visual and other bugs +# +# Revision 1.2 1998/11/18 09:01:34 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $p $cust_main_county ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header("Tax Rate Listing", menubar( - 'Main Menu' => '../', - 'Edit tax rates' => "../edit/cust_main_county.cgi", +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("Tax Rate Listing", menubar( + 'Main Menu' => $p, + 'Edit tax rates' => $p. "edit/cust_main_county.cgi", )),<<END; - <BR>Click on <u>expand</u> to specify tax rates by county. - <P><TABLE BORDER> + Click on <u>expand country</u> to specify a country's tax rates by state. + <BR>Click on <u>expand state</u> to specify a state's tax rates by county. + <BR><BR> +END +print &table(), <<END; <TR> + <TH><FONT SIZE=-1>Country</FONT></TH> <TH><FONT SIZE=-1>State</FONT></TH> <TH>County</TH> <TH><FONT SIZE=-1>Tax</FONT></TH> </TR> END -my($cust_main_county); foreach $cust_main_county ( qsearch('cust_main_county',{}) ) { my($hashref)=$cust_main_county->hashref; print <<END; <TR> - <TD>$hashref->{state}</TD> + <TD>$hashref->{country}</TD> END - - print "<TD>", $hashref->{county} - ? $hashref->{county} + print "<TD>", $hashref->{state} + ? $hashref->{state} : qq!(ALL) <FONT SIZE=-1>!. - qq!<A HREF="../edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}. - qq!">expand</A></FONT>! + qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}. + qq!">expand country</A></FONT>! , "</TD>"; + print "<TD>"; + if ( $hashref->{county} ) { + print $hashref->{county}; + } else { + print "(ALL)"; + if ( $hashref->{state} ) { + print qq!<FONT SIZE=-1>!. + qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}. + qq!">expand state</A></FONT>!; + } + } + print "</TD>"; print <<END; <TD>$hashref->{tax}%</TD> diff --git a/htdocs/browse/part_pkg.cgi b/htdocs/browse/part_pkg.cgi index e5ff31e9e..d4c359b28 100755 --- a/htdocs/browse/part_pkg.cgi +++ b/htdocs/browse/part_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_svc.cgi: browse part_pkg +# $Id: part_pkg.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-5,9 # @@ -8,29 +8,57 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_pkg.cgi,v $ +# Revision 1.8 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.7 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.6 1999/01/19 05:13:27 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:17 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/17 05:25:19 ivan +# fix visual and other bugs +# +# Revision 1.3 1998/11/21 07:23:45 ivan +# visual +# +# Revision 1.2 1998/11/21 07:00:32 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $p $part_pkg ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::part_pkg; +use FS::pkg_svc; +use FS::part_svc; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +$p = popurl(2); -print header("Package Part Listing",menubar( - 'Main Menu' => '../', - 'Add new package' => "../edit/part_pkg.cgi", -)), <<END; - <BR>Click on package part number to edit. +print $cgi->header( '-expires' => 'now' ), header("Package Part Listing",menubar( + 'Main Menu' => $p, +)), "One or more services are grouped together into a package and given", + " pricing information. Customers purchase packages, not services.<BR><BR>", + &table(), <<END; <TABLE BORDER> <TR> - <TH><FONT SIZE=-1>Part #</FONT></TH> - <TH>Package</TH> + <TH COLSPAN=2>Package</TH> <TH>Comment</TH> <TH><FONT SIZE=-1>Setup Fee</FONT></TH> <TH><FONT SIZE=-1>Freq.</FONT></TH> @@ -40,7 +68,6 @@ print header("Package Part Listing",menubar( </TR> END -my($part_pkg); foreach $part_pkg ( sort { $a->getfield('pkgpart') <=> $b->getfield('pkgpart') } qsearch('part_pkg',{}) ) { @@ -50,10 +77,10 @@ foreach $part_pkg ( sort { my($rowspan)=scalar(@pkg_svc); print <<END; <TR> - <TD ROWSPAN=$rowspan><A HREF="../edit/part_pkg.cgi?$hashref->{pkgpart}"> + <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}"> $hashref->{pkgpart} </A></TD> - <TD ROWSPAN=$rowspan>$hashref->{pkg}</TD> + <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkg}</A></TD> <TD ROWSPAN=$rowspan>$hashref->{comment}</TD> <TD ROWSPAN=$rowspan>$hashref->{setup}</TD> <TD ROWSPAN=$rowspan>$hashref->{freq}</TD> @@ -61,20 +88,22 @@ foreach $part_pkg ( sort { END my($pkg_svc); + my($n)=""; foreach $pkg_svc ( @pkg_svc ) { my($svcpart)=$pkg_svc->getfield('svcpart'); my($part_svc) = qsearchs('part_svc',{'svcpart'=> $svcpart }); - print qq!<TD><A HREF="../edit/part_svc.cgi?$svcpart">!, + print $n,qq!<TD><A HREF="${p}edit/part_svc.cgi?$svcpart">!, $part_svc->getfield('svc'),"</A></TD><TD>", - $pkg_svc->getfield('quantity'),"</TD></TR><TR>\n"; + $pkg_svc->getfield('quantity'),"</TD></TR>\n"; + $n="<TR>"; } print "</TR>"; } print <<END; - </TR></TABLE> - </CENTER> + <TR><TD COLSPAN=2><I><A HREF="${p}edit/part_pkg.cgi">Add new package</A></I></TD></TR> + </TABLE> </BODY> </HTML> END diff --git a/htdocs/browse/part_referral.cgi b/htdocs/browse/part_referral.cgi index b16fa896d..e4ca25a65 100755 --- a/htdocs/browse/part_referral.cgi +++ b/htdocs/browse/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_referral.cgi: Browse part_referral +# $Id: part_referral.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -8,47 +8,78 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# Revision 1.9 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.8 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.7 1999/01/19 05:13:28 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:18 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/17 05:25:20 ivan +# fix visual and other bugs +# +# Revision 1.4 1998/12/17 04:32:55 ivan +# print $cgi->header +# +# Revision 1.3 1998/12/17 04:31:36 ivan +# use CGI::Carp +# +# Revision 1.2 1998/12/17 04:26:04 ivan +# use CGI; no relative URLs +# use strict; -use CGI::Base; +use vars qw( $cgi $p $part_referral ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::part_referral; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header("Referral Listing", menubar( - 'Main Menu' => '../', - 'Add new referral' => "../edit/part_referral.cgi", -)), <<END; - <BR>Click on referral number to edit. - <TABLE BORDER> +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("Referral Listing", menubar( + 'Main Menu' => $p, +# 'Add new referral' => "../edit/part_referral.cgi", +)), "Where a customer heard about your service. Tracked for informational purposes.<BR><BR>", &table(), <<END; <TR> - <TH><FONT SIZE=-1>Referral #</FONT></TH> - <TH>Referral</TH> + <TH COLSPAN=2>Referral</TH> </TR> END -my($part_referral); foreach $part_referral ( sort { $a->getfield('refnum') <=> $b->getfield('refnum') } qsearch('part_referral',{}) ) { my($hashref)=$part_referral->hashref; print <<END; <TR> - <TD><A HREF="../edit/part_referral.cgi?$hashref->{refnum}"> + <TD><A HREF="${p}edit/part_referral.cgi?$hashref->{refnum}"> $hashref->{refnum}</A></TD> - <TD>$hashref->{referral}</TD> + <TD><A HREF="${p}edit/part_referral.cgi?$hashref->{refnum}"> + $hashref->{referral}</A></TD> </TR> END } print <<END; + <TR> + <TD COLSPAN=2><A HREF="${p}edit/part_referral.cgi"><I>Add new referral</I></A></TD> + </TR> </TABLE> </CENTER> </BODY> diff --git a/htdocs/browse/part_svc.cgi b/htdocs/browse/part_svc.cgi index 71a556421..123cb7d2a 100755 --- a/htdocs/browse/part_svc.cgi +++ b/htdocs/browse/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_svc.cgi: browse part_svc +# $Id: part_svc.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-nov-14, 97-dec-9 # @@ -8,37 +8,70 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_svc.cgi,v $ +# Revision 1.11 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.10 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.9 1999/01/19 05:13:29 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:19 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.7 1998/12/30 23:06:22 ivan +# typo +# +# Revision 1.6 1998/12/30 23:03:20 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.5 1998/12/17 05:25:21 ivan +# fix visual and other bugs +# +# Revision 1.4 1998/11/21 02:26:22 ivan +# visual +# +# Revision 1.3 1998/11/20 23:10:57 ivan +# visual +# +# Revision 1.2 1998/11/20 08:50:37 ivan +# s/CGI::Base/CGI.pm, visual fixes +# use strict; -use CGI::Base; -use FS::UID qw(cgisuidsetup swapuid); -use FS::Record qw(qsearch); -use FS::part_svc qw(fields); -use FS::CGI qw(header menubar); +use vars qw( $cgi $p $part_svc ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearch fields); +use FS::part_svc; +use FS::CGI qw(header menubar popurl table); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header('Service Part Listing', menubar( - 'Main Menu' => '../', - 'Add new service' => "../edit/part_svc.cgi", +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('Service Part Listing', menubar( + 'Main Menu' => $p, )),<<END; - <BR>Click on service part number to edit. - <TABLE BORDER> + Services are items you offer to your customers.<BR><BR> +END +print &table(), <<END; <TR> - <TH>Part #</TH> - <TH>Service</TH> + <TH COLSPAN=2>Service</TH> <TH>Table</TH> <TH>Field</TH> - <TH>Action</TH> - <TH>Value</TH> + <TH COLSPAN=2>Modifier</TH> </TR> END -my($part_svc); foreach $part_svc ( sort { $a->getfield('svcpart') <=> $b->getfield('svcpart') } qsearch('part_svc',{}) ) { @@ -51,30 +84,34 @@ foreach $part_svc ( sort { grep /^${svcdb}__/, fields('part_svc') ; - my($rowspan)=scalar(@rows); + my($rowspan)=scalar(@rows) || 1; print <<END; <TR> - <TD ROWSPAN=$rowspan><A HREF="../edit/part_svc.cgi?$hashref->{svcpart}"> - $hashref->{svcpart} - </A></TD> - <TD ROWSPAN=$rowspan>$hashref->{svc}</TD> + <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_svc.cgi?$hashref->{svcpart}"> + $hashref->{svcpart}</A></TD> + <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_svc.cgi?$hashref->{svcpart}"> $hashref->{svc}</A></TD> <TD ROWSPAN=$rowspan>$hashref->{svcdb}</TD> END + + my($n1)=''; my($row); foreach $row ( @rows ) { my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag'); - print "<TD>$row</TD><TD>"; + print $n1,"<TD>$row</TD><TD>"; if ( $flag eq "D" ) { print "Default"; } elsif ( $flag eq "F" ) { print "Fixed"; } else { print "(Unknown!)"; } - print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD></TR><TR>"; + print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD>"; + $n1="</TR><TR>"; } print "</TR>"; } print <<END; + <TR> + <TD COLSPAN=2><A HREF="${p}edit/part_svc.cgi"><I>Add new service</I></A></TD> + </TR> </TABLE> - </CENTER> </BODY> </HTML> END diff --git a/htdocs/browse/svc_acct_pop.cgi b/htdocs/browse/svc_acct_pop.cgi index a8a3a9224..1ddbcdc2e 100755 --- a/htdocs/browse/svc_acct_pop.cgi +++ b/htdocs/browse/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct_pop.cgi: browse pops +# $Id: svc_acct_pop.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,27 +8,49 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.7 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.6 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.5 1999/01/19 05:13:30 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:20 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 05:25:22 ivan +# fix visual and other bugs +# +# Revision 1.2 1998/12/17 04:36:59 ivan +# use CGI;, use CGI::Carp, visual changes, relative URLs +# use strict; -use CGI::Base; +use vars qw( $cgi $p $svc_acct_pop ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar table popurl); +use FS::svc_acct_pop; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header('POP Listing', menubar( - 'Main Menu' => '../', - 'Add new POP' => "../edit/svc_acct_pop.cgi", -)), <<END; - <BR>Click on pop number to edit. - <TABLE BORDER> +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('POP Listing', menubar( + 'Main Menu' => $p, +)), "Points of Presence<BR><BR>", &table(), <<END; <TR> - <TH><FONT SIZE=-1>POP #</FONT></TH> + <TH></TH> <TH>City</TH> <TH>State</TH> <TH>Area code</TH> @@ -36,25 +58,31 @@ print header('POP Listing', menubar( </TR> END -my($svc_acct_pop); foreach $svc_acct_pop ( sort { $a->getfield('popnum') <=> $b->getfield('popnum') } qsearch('svc_acct_pop',{}) ) { my($hashref)=$svc_acct_pop->hashref; print <<END; <TR> - <TD><A HREF="../edit/svc_acct_pop.cgi?$hashref->{popnum}"> + <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}"> $hashref->{popnum}</A></TD> - <TD>$hashref->{city}</TD> - <TD>$hashref->{state}</TD> - <TD>$hashref->{ac}</TD> - <TD>$hashref->{exch}</TD> + <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}"> + $hashref->{city}</A></TD> + <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}"> + $hashref->{state}</A></TD> + <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}"> + $hashref->{ac}</A></TD> + <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}"> + $hashref->{exch}</A></TD> </TR> END } print <<END; + <TR> + <TD COLSPAN=5><A HREF="${p}edit/svc_acct_pop.cgi"><I>Add new POP</I></A></TD> + </TR> </TABLE> </CENTER> </BODY> diff --git a/htdocs/docs/CGI-modules-2.76-patch.txt b/htdocs/docs/CGI-modules-2.76-patch.txt deleted file mode 100755 index 55b50bbbe..000000000 --- a/htdocs/docs/CGI-modules-2.76-patch.txt +++ /dev/null @@ -1,23 +0,0 @@ -ivan@rootwood:~/src/CGI-modules-2.76/CGI$ diff -c Base.pm Base.pm.orig -*** Base.pm Sat Jul 18 00:33:21 1998 ---- Base.pm.orig Sat Jul 18 00:06:12 1998 -*************** -*** 938,945 **** - my $orig_uri = $self->get_uri; - $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri") - if $Debug; -! my $msg = ($perm) ? StatusHdr(301,"Moved Permanently") -! : StatusHdr(302,"Moved Temporarily"); - my $hdrs = SendHeaders($msg, LocationHdr($to_uri)); - $self->log($hdrs); - } ---- 938,945 ---- - my $orig_uri = $self->get_uri; - $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri") - if $Debug; -! my $msg = ($perm) ? ServerHdr(301,"Moved Permanently") -! : ServerHdr(302,"Moved Temporarily"); - my $hdrs = SendHeaders($msg, LocationHdr($to_uri)); - $self->log($hdrs); - } - diff --git a/htdocs/docs/config.html b/htdocs/docs/config.html index 9b8002601..1a30b525e 100644 --- a/htdocs/docs/config.html +++ b/htdocs/docs/config.html @@ -3,7 +3,23 @@ </head> <body> <h1>Configuration files</h1> -Configuration files and directories are located in `/var/spool/freeside/conf'. +Configuration file layout has changed in 1.2.x. +<ul> + <li>First, the file `/usr/local/etc/freeside/mapsecrets' is read. Each line +in this file contains a username and filename, separated by whitespace. Note +that these are not local usernames - they are passed from Apache (you _did_ +setup <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication"> +user authetication</a>, correct?). Filenames are located in +`/usr/local/etc/freeside/'. The specified filename is parsed exactly +the same as the pre-1.2.x `secrets' file: + <li>Three lines: Database engine datasource (for example, + `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password. + This file should not be world readable. See the DBI manpage and the manpage + for your DBD for the exact syntax. +</ul> +All further configuration files and directories are located in +`/usr/local/etc/freeside/conf.<i>datasource</i>', for example, +`/usr/local/etc/freeside/conf.DBI:Pg:dbname=freeside' <ul> <li>address - Your company name and address, four lines. <li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'. @@ -12,6 +28,7 @@ Configuration files and directories are located in `/var/spool/freeside/conf'. <li>domain - Your domain name. <li>erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'. <li>home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash. + <li>invoice_from - Return address on email invoices. <li>lpr - Print command for paper invoices, for example `lpr -h'. <li>nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'. <li>qmailmachines - Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains', `/var/qmail/control/recipientmap', and `/var/qmail/control/rcpthosts'. The existance of this file (even if empty) also turns on user `.qmail-extension' file maintenance in conjunction with `shellmachine'. @@ -27,7 +44,6 @@ Configuration files and directories are located in `/var/spool/freeside/conf'. <li>registries/internic/to - Email address to which InterNIC domain registrations are sent. </ul> </ul> - <li>secrets - Three lines: Database engine datasource (for example, `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password. This file should not be world readable. <li>sendmailmachines - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'. <li>shellmachine - A single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines', it also enables `.qmail-extension' file maintenance. <li>shellmachines - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files. diff --git a/htdocs/docs/export.html b/htdocs/docs/export.html index f760b97dd..86a2b4ccd 100644 --- a/htdocs/docs/export.html +++ b/htdocs/docs/export.html @@ -4,29 +4,30 @@ <body> <h1>File exporting</h1> <ul> - <li>bin/svc_acct.export will create UNIX `passwd', `shadow' and `master.passwd' files, ERPCD `acp_passwd' and `acp_dialup' files and a RADIUS `users' file in the `/var/spool/freeside/export' 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 - passwd and shadow are copied to the remote machine as /etc/passwd.new and /etc/shadow.net and then moved to /etc/passwd and /etc/shadow if no errors occur. - <li>bsdshellmachines - passwd and master.passwd are copied to the remote machine as /etc/passwd.new and /etc/master.passwd.new and moved to /etc/passwd and /etc/master.passwd if no errors occur. - <li>nismachines - passwd and shadow are copied to the `/etc/global' directory on the remote machine. If no errors occur, the command `( cd /var/yp; make; )' is executed on the remote machine. - <li>erpcdmachines - acp_passwd and acp_dialup are copied to the `/usr/annex' directory on the remote machine. If no errors occur, the command `( kill -USR1 `cat /usr/annex/erpcd.pid` )' is executed on the remote machine. - <li>radiusmachines - users is copied to the `/etc/raddb' directory on the remote machine. If no errors occur, the command `( builddbm )' is executed on the remote machine. + <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. + <li>nismachines - <b>passwd</b> and <b>shadow</b> are copied to the <b>/etc/global</b> directory on the remote machine. If no errors occur, the command <b>( cd /var/yp; make; )</b> is executed on the remote machine. + <li>erpcdmachines - <b>acp_passwd</b> and <b>acp_dialup</b> are copied to the <b>/usr/annex</b> directory on the remote machine. If no errors occur, the command <b>( kill -USR1 `cat /usr/annex/erpcd.pid` )</b> is executed on the remote machine. + <li>radiusmachines - <b>users</b> is copied to the <b>/etc/raddb</b> directory on the remote machine. If no errors occur, the command <b>( builddbm )</b> is executed on the remote machine. </ul> <li>site_perl/svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below. <ul> - <li>The command `useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i>' is executed when a user is added. - <li>The command `userdel <i>username</i>' is executed with a user is deleted. - <li>If a user's home directory changes, the command `[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )' is executed. + <li>The command <b>useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i></b> is executed when a user is added. + <li>The command <b>userdel <i>username</i></b> is executed with a user is deleted. + <li>If a user's home directory changes, the command <b>[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )</b> is executed. </ul> - <li>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a> `rcpthosts', `recipientmap' and `virtualdomains' files and <a href="http://www.sendmail.org">Sendmail</a> `virtusertable' and `sendmail.cw' files in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattemded; see below. + <li>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a> <b>rcpthosts</b>, <b>recipientmap</b> and <b>virtualdomains</b> files and <a href="http://www.sendmail.org">Sendmail</a> <b>virtusertable</b> and <b>sendmail.cw</b> files 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 unattemded; see below. <ul> - <li>qmailmachines - recipientmap, virtualdomains and rcpthosts are copied to the `/var/qmail/control' directory on the remote machine. Note: If you <a href="legacy.html#svc_acct_sm">imported</a> qmail configuration files, run the generated `/var/spool/freeside/export/virtualdomains.FIX' on a machine with your user home directories before exporting qmail configuration files. - <li>shellmachine - The command `[ -e <i>homedir</i>/.qmail-default ] || { touch <i>homedir</i>/.qmail-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-default; }' will be run on this machine for users in the virtualdomains file. - <li>sendmailmachines - sendmail.cw and virtusertable are copied to the remote machine as /etc/sendmail.cw.new and /etc/virtusertable.new and moved to /etc/sendmail.cw and /etc/virtusertable if no errors occur. + <li>qmailmachines - <b>recipientmap</b>, <b>virtualdomains</b> and <b>rcpthosts</b> are copied to the <b>/var/qmail/control</b> directory on the remote machine. Note: If you <a href="legacy.html#svc_acct_sm">imported</a> qmail configuration files, run the generated <b>/usr/local/etc/freeside/export.<i>datasrc</i>/virtualdomains.FIX</b> on a machine with your user home directories before exporting qmail configuration files. + <li>shellmachine - The command <b>[ -e <i>homedir</i>/.qmail-default ] || { touch <i>homedir</i>/.qmail-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-default; }</b> will be run on this machine for users in the virtualdomains file. + <li>sendmailmachines - <b>sendmail.cw</b> and <b>virtusertable</b> are copied to the remote machine as <b>/etc/sendmail.cw.new</b> and <b>/etc/virtusertable.new</b> and moved to <b>/etc/sendmail.cw</b> and <b>/etc/virtusertable</b> if no errors occur. </ul> - <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user `.qmail-' files can be updated. + <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user <b>.qmail-</b> files can be updated. <ul> - <li>The command `[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }' is run. + <li>The command <b>[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }</b> is run. </ul> </ul> <br><a name=ssh>Unattended remote login</a> - Freeside can login to remote machines unattended using SSH. This can pose a security risk if not configured correctly, and will allow an intruder who breaks into your freeside machine full access to your remote machines. <b>Do not use this feature unless you understand what you are doing!</b> diff --git a/htdocs/docs/index.html b/htdocs/docs/index.html index 20051ca4d..d593a5e3b 100644 --- a/htdocs/docs/index.html +++ b/htdocs/docs/index.html @@ -6,7 +6,8 @@ <ul> <li><a href="install.html">New Installation</a> <li><a href="upgrade.html">Upgrading from 1.0.x to 1.1.x</a> - <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.3</a> + <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.4</a> + <li><a href="upgrade3.html">Upgrading from 1.1.x to 1.2.x</a> <li><a href="config.html">Configuration files</a> <!-- <li><a href="admin.html">Administration</a> diff --git a/htdocs/docs/install.html b/htdocs/docs/install.html index c4784ebf6..7aaad14ae 100644 --- a/htdocs/docs/install.html +++ b/htdocs/docs/install.html @@ -7,17 +7,18 @@ Before installing, you need: <ul> <li>A web server, such as <a href="http://www.apache-ssl.org">Apache-SSL</a> or <a href="http://www.apache.org">Apache</a> <li><a href="ftp://ftp.cs.hut.fi/pub/ssh/">SSH</a> - <li>agrep from the <a href="http://glimpse.cs.arizona.edu">Glimpse</a> distribution, if you want fuzzy searching capability - <li><a href="http://www.perl.com/CPANl/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_04) - <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a> + <li><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_04) + <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a> (see the <a href="postgresql.html">PostgreSQL notes</a>) <li>Perl modules <ul> + <li><a href="http://www.perl.com/CPAN/modules/by-module/Array/">Array-PrintCols</a> + <li><a href="http://www.perl.com/CPAN/modules/by-module/Term/">Term-Query</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/MIME/">MIME-Base64</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/Data">Data-Dumper</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/MD5">MD5</a> + <li><a href="http://www.perl.com/CPAN/modules/by-module/URI">URI</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/Net">libnet</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/LWP/">libwww-perl</a> - <li><a href="http://www.perl.com/CPAN/modules/by-module/CGI/">CGI-modules</a> (<b>NOT</b> CGI.pm) with this <a href="CGI-modules-2.76-patch.txt">patch</a> applied <li><a href="http://www.perl.com/CPAN/modules/by-module/Business/">Business-CreditCard</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/Data/">Data-ShowTable</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/Mail/">MailTools</a> @@ -25,6 +26,7 @@ Before installing, you need: <li><a href="http://www.perl.com/CPAN/modules/by-module/Date/">DateManip</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/File/">File-CounterFile</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/FreezeThaw/">FreezeThaw</a> + <li><a href="http://www.perl.com/CPAN/modules/by-module/String/">String-Approx</a> <li><a href="http://www.perl.com/CPAN/modules/by-module/DBI/">DBI <li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a> </ul> @@ -41,16 +43,24 @@ cp fs-x.y.z/site_perl/* /usr/local/lib/site_perl/FS</pre> or <pre>ln -s /full/pa cp -r fs-x.y.z/htdocs/* /usr/local/apache/htdocs/freeside</pre> or <pre>ln -s /full/path/to/fs-x.y.z/htdocs /usr/local/apache/htdocs/freeside</pre> <li>Restrict access to this web interface. (with <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">Apache</a>) <li>Enable CGI execution for files with the `.cgi' extension. (with <a href="http://www.apache.org/docs/mod/mod_mime.html#addhandler">Apache</a>) - <li>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. + <li>Set ownership and permissions for the web interface. The web interface needs to run as the freeside user - there are several ways to do this. + <ul> + <li>Use Perl's setuid emulation: see the <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">Security Bugs</a> section of the <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html">perlsec</a> manpage. <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> -<li>Create the base Freeside directory `/var/spool/freeside', and the subdirectories `conf', `counters', and `export'. <pre>mkdir /var/spool/freeside -mkdir /var/spool/freeside/conf -mkdir /var/spool/freeside/counters -mkdir /var/spool/freeside/export -chown -R freeside /var/spool/freeside</pre> - <li>Create the necessary <a href="config.html">configuration files</a>. - <li>Run bin/fs-setup to create the database tables. + <li>Use Apache's <a href="http://www.apache.org/docs/suexec.html">suEXEC</a>. +<pre>cd /usr/local/apache/htdocs/freeside +chown -R freeside . +chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre> + <li>Use <a href="http://perl.apache.org/">mod_perl</a>. You should run a separate iteration of Apache[-SSL] as the freeside user. (Warning: The redirect method of CGI.pm 2.36 [as distributed with Perl 5.004_04] is broken under mod_perl. Downlaod the current version from <a href="http://www.perl.com/CPAN/modules/by-module/CGI">CPAN</a>. Apache 1.3.6 is also highly recommended because of signal handling problems in earlier versions.) +<pre>cd /usr/local/apache/htdocs/freeside +chown -R root . +chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre> + </ul> +<li>Create the necessary <a href="config.html">configuration files</a>. +<li>Create the `/usr/local/etc/freeside/counters.<i>datasrc</i>', and + `/usr/local/etc/freeside/export.<i>datasrc</i>' directories for each <i>datasrc</i> (owned by the freeside user). + <li>As the freeside user, run bin/fs-setup to create the database tables. </ul> </body> diff --git a/htdocs/docs/legacy.html b/htdocs/docs/legacy.html index 40e09cb3c..3ab21dab2 100644 --- a/htdocs/docs/legacy.html +++ b/htdocs/docs/legacy.html @@ -4,7 +4,7 @@ <body> <h1>Importing legacy data</h1> <ul> - <li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> (with table svc_acct) as follows: + <li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="../browse/part_svc.cgi">services</a> (with table svc_acct) as follows: <ul> <li>Most accounts probably have entries in passwd and users (with Port-Limit nonexistant or 1) <li>Some accounts have entries in passwd and users, but with Port-Limit 2 (or more) @@ -13,7 +13,7 @@ <li>POP mail accounts have entries in passwd only, and have a particular shell. <li>Everything else in passwd is a shell account. </ul> - <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> as follows: + <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="../browse/part_svc.cgi">services</a> as follows: <ul> <li>Domain (table svc_acct) <li>Mail alias (table svc_acct_sm) diff --git a/htdocs/docs/man/CGI.txt b/htdocs/docs/man/CGI.txt index 54f9b8a6a..c8eb4ff23 100644 --- a/htdocs/docs/man/CGI.txt +++ b/htdocs/docs/man/CGI.txt @@ -2,7 +2,7 @@ NAME FS::CGI - Subroutines for the web interface SYNOPSIS - use FS::CGI qw(header menubar idiot eidiot); + use FS::CGI qw(header menubar idiot eidiot popurl); print header( 'Title', '' ); print header( 'Title', menubar('item', 'URL', ... ) ); @@ -10,6 +10,9 @@ SYNOPSIS idiot "error message"; eidiot "error message"; + $url = popurl; #returns current url + $url = popurl(3); #three levels up + DESCRIPTION Provides a few common subroutines for the web interface. @@ -21,20 +24,35 @@ SUBROUTINES Returns an HTML menubar. idiot ERROR + This is depriciated. Don't use it. + Sends headers and an HTML error message. eidiot ERROR + This is depriciated. Don't use it. + Sends headers and an HTML error message, then exits. + popurl LEVEL + Returns current URL with LEVEL levels of path removed from + the end (default 0). + + table + Returns HTML tag for beginning a table. + + itable + Returns HTML tag for beginning an (invisible) table. + + ntable + This is getting silly. + BUGS Not OO. Not complete. - Uses CGI-modules instead of CGI.pm - SEE ALSO - the CGI::Base manpage + the CGI manpage, the CGI::Base manpage HISTORY subroutines for the HTML/CGI GUI, not properly OO. :( @@ -45,3 +63,36 @@ HISTORY pod ivan@sisd.com 98-sep-12 + $Log: CGI.txt,v $ + Revision 1.4 1999-04-08 13:39:31 ivan + convert from pod for 1.2.0 release + 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 all $cgi->header calls + now include ( '-expires' => 'now' ) for mod_perl (good idea + anyway) + + Revision 1.14 1999/01/18 09:22:37 ivan changes to track email + addresses for email invoicing + + Revision 1.12 1998/12/23 02:23:16 ivan popurl always has + trailing slash + + Revision 1.11 1998/11/12 07:43:54 ivan *** empty log message *** + + Revision 1.10 1998/11/12 01:53:47 ivan added table command + + Revision 1.9 1998/11/09 08:51:49 ivan bug squash + + Revision 1.7 1998/11/09 06:10:59 ivan added sub url + + Revision 1.6 1998/11/09 05:44:20 ivan *** empty log message *** + + Revision 1.4 1998/11/09 04:55:42 ivan support depriciated + CGI::Base as well as CGI.pm (for now) + + Revision 1.3 1998/11/08 10:50:19 ivan s/CGI::Base/CGI/; etc. + diff --git a/htdocs/docs/man/Conf.txt b/htdocs/docs/man/Conf.txt index c46c9ee6a..01b7cf5e6 100644 --- a/htdocs/docs/man/Conf.txt +++ b/htdocs/docs/man/Conf.txt @@ -4,8 +4,10 @@ NAME SYNOPSIS use FS::Conf; + $conf = new FS::Conf "/config/directory"; + + $FS::Conf::default_dir = "/config/directory"; $conf = new FS::Conf; - $conf = new FS::Conf "/non/standard/config/directory"; $dir = $conf->dir; @@ -19,8 +21,8 @@ DESCRIPTION METHODS new [ DIRECTORY ] - Create a new configuration object. Optionally, a non-default - directory may be specified. + Create a new configuration object. A directory arguement is + required if $FS::Conf::default_dir has not been set. dir Returns the directory. @@ -33,9 +35,6 @@ METHODS corresponding value is undefined. BUGS - The option to specify a non-default directory should probably be - removed. - Write access (with locking) should be implemented. SEE ALSO @@ -45,3 +44,14 @@ SEE ALSO HISTORY Ivan Kohler <ivan@sisd.com> 98-sep-6 + sub exists forgot to fetch $dir ivan@sisd.com 98-sep-27 + + $Log: Conf.txt,v $ + Revision 1.5 1999-04-08 13:39:31 ivan + convert from pod for 1.2.0 release + Revision 1.3 1999/03/29 01:29:33 ivan die + unless the configuration directory exists + + Revision 1.2 1998/11/13 04:08:44 ivan no default default_dir + (ironic) + diff --git a/htdocs/docs/man/Invoice.txt b/htdocs/docs/man/Invoice.txt index 17953d51d..d0ca37fd0 100644 --- a/htdocs/docs/man/Invoice.txt +++ b/htdocs/docs/man/Invoice.txt @@ -2,7 +2,7 @@ NAME FS::Invoice - Legacy stub SYNOPSIS - The functioanlity of FS::invoice has been integrated in + The functionality of FS::Invoice has been integrated in FS::cust_bill. HISTORY @@ -21,3 +21,7 @@ HISTORY =< 0 return address comes from /var/spool/freeside/conf/address ivan@sisd.com 98-jul-2 + pod ivan@sisd.com 98-sep-20something + + s/ISA/@ISA/ in use vars ivan@sisd.com 98-sep-27 + diff --git a/htdocs/docs/man/Record.txt b/htdocs/docs/man/Record.txt index 0accb65d1..1708e3c67 100644 --- a/htdocs/docs/man/Record.txt +++ b/htdocs/docs/man/Record.txt @@ -3,7 +3,7 @@ NAME SYNOPSIS use FS::Record; - use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef); + use FS::Record qw(dbh fields qsearch qsearchs dbdef); $record = new FS::Record 'table', \%hash; $record = new FS::Record 'table', { 'column' => 'value', ... }; @@ -28,11 +28,14 @@ SYNOPSIS $hashref = $record->hashref; - $error = $record->add; + $error = $record->insert; + #$error = $record->add; #depriciated - $error = $record->del; + $error = $record->delete; + #$error = $record->del; #depriciated - $error = $new_record->rep($old_record); + $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #depriciated $value = $record->unique('column'); @@ -57,7 +60,8 @@ SYNOPSIS $fields = hfields('table'); if ( $fields->{Field} ) { # etc. - @fields = fields 'table'; + @fields = fields 'table'; #as a subroutine + @fields = $record->fields; #as a method call DESCRIPTION (Mostly) object-oriented interface to database records. Records @@ -65,28 +69,32 @@ DESCRIPTION as a base class for table-specific classes to inherit from, i.e. FS::cust_main. -METHODS - new TABLE, HASHREF +CONSTRUCTORS + new [ TABLE, ] HASHREF Creates a new record. It doesn't store it in the database, - though. See the section on "add" for that. + though. See the section on "insert" for that. Note that the object stores this hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the *hash* method. + TABLE can only be omitted when a dervived class overrides + the table method. + qsearch TABLE, HASHREF Searches the database for all records matching (at least) the key/value pairs in HASHREF. Returns all the records - found as FS::Record objects. + found as `FS::TABLE' objects if that module is loaded (i.e. + via `use FS::cust_main;'), otherwise returns FS::Record + objects. qsearchs TABLE, HASHREF - Searches the database for a record matching (at least) the - key/value pairs in HASHREF, and returns the record found as - an FS::Record object. If more than one record matches, it - carps but returns the first. If this happens, you either - made a logic error in asking for a single item, or your data - is corrupted. + Same as qsearch, except that if more than one record + matches, it carps but returns the first. If this happens, + you either made a logic error in asking for a single item, + or your data is corrupted. +METHODS table Returns the table name. @@ -118,17 +126,29 @@ METHODS hashref Returns a reference to the column/value hash. - add Adds this record to the database. If there is an error, returns - the error, otherwise returns false. + insert + Inserts this record to the database. If there is an error, + returns the error, otherwise returns false. + + add Depriciated (use insert instead). - del Delete this record from the database. If there is an error, + delete + Delete this record from the database. If there is an error, returns the error, otherwise returns false. - rep OLD_RECORD + del Depriciated (use delete instead). + + replace OLD_RECORD Replace the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. + rep Depriciated (use replace instead). + + check + Not yet implemented, croaks. Derived classes should provide + a check method. + unique COLUMN Replaces COLUMN in record with a unique number. Called by the add method on primary keys and single-field unique @@ -184,6 +204,11 @@ METHODS ut_anything COLUMN Untaints arbitrary data. Be careful. + fields [ TABLE ] + This can be used as both a subroutine and a method call. It + returns a list of the columns in this record's table, or an + explicitly specified table. (See the dbdef_table manpage). + SUBROUTINES reload_dbdef([FILENAME]) Load a database definition (see the FS::dbdef manpage), @@ -207,9 +232,8 @@ SUBROUTINES It returns a hash-type list with the fields of this record's table set true. - fields TABLE - This returns a list of the columns in this record's - table (See the dbdef_table manpage). +VERSION + $Id: Record.txt,v 1.5 1999-04-08 13:39:31 ivan Exp $ BUGS This module should probably be renamed, since much of the @@ -236,7 +260,7 @@ BUGS ut_sqltype (like ut_varchar) should all be defined - A fallback check method should be provided with uses the + A fallback check method should be provided whith uses the dbdef. The ut_money method assumes money has two decimal digits. @@ -251,6 +275,9 @@ BUGS All the subroutines probably should be methods, here or elsewhere. + Probably should borrow/use some dbdef methods where + appropriate (like sub fields) + SEE ALSO the FS::dbdef manpage, the FS::UID manpage, the DBI manpage @@ -330,3 +357,49 @@ HISTORY added pod documentation ivan@sisd.com 98-sep-6 + ut_phonen got ''; at the end ivan@sisd.com 98-sep-27 + + $Log: Record.txt,v $ + Revision 1.5 1999-04-08 13:39:31 ivan + convert from pod for 1.2.0 release + Revision 1.15 1999/04/08 12:08:59 ivan + fix up PostgreSQL money fields so you can actually use them + as numbers. bah. + + Revision 1.14 1999/04/07 14:58:31 ivan more kludges to get + around different null/empty handling in Perl vs. MySQL vs. + PostgreSQL etc. + + Revision 1.13 1999/03/29 11:55:43 ivan eliminate warnings in + ut_money + + Revision 1.12 1999/01/25 12:26:06 ivan yet more mod_perl + stuff + + Revision 1.11 1999/01/18 09:22:38 ivan changes to track + email addresses for email invoicing + + Revision 1.10 1998/12/29 11:59:33 ivan mostly properly OO, + some work still to be done with svc_ stuff + + Revision 1.9 1998/11/21 07:26:45 ivan "Records identical" + carp tells us it is just a warning. + + Revision 1.8 1998/11/15 11:02:04 ivan bugsquash + + Revision 1.7 1998/11/15 10:56:31 ivan qsearch gets sames "IS + NULL" semantics as other WHERE clauses + + Revision 1.6 1998/11/15 05:31:03 ivan bugfix for new config + layout + + Revision 1.5 1998/11/13 09:56:51 ivan change configuration + file layout to support multiple distinct databases (with own + set of config files, export, etc.) + + Revision 1.4 1998/11/10 07:45:25 ivan doc clarification + + Revision 1.2 1998/11/07 05:17:18 ivan In sub new, Pg wrapper + for money fields from dbdef (FS::Record::fields $table), not + keys of supplied hashref. + diff --git a/htdocs/docs/man/UID.txt b/htdocs/docs/man/UID.txt index bf9f6b4bd..efe3b6670 100644 --- a/htdocs/docs/man/UID.txt +++ b/htdocs/docs/man/UID.txt @@ -6,10 +6,9 @@ SYNOPSIS use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker checkeuid checkruid swapuid); - adminsuidsetup; + adminsuidsetup $user; - $cgi = new CGI::Base; - $cgi->get; + $cgi = new CGI; $dbh = cgisuidsetup($cgi); $dbh = dbh; @@ -20,20 +19,32 @@ DESCRIPTION Provides a hodgepodge of subroutines. SUBROUTINES - adminsuidsetup - Cleans the environment. Make sure the script is running as - freeside, or setuid freeside. Opens a connection to the - database. Swaps real and effective UIDs. Returns the DBI + adminsuidsetup USER + Sets the user to USER (see config.html from the base + documentation). Cleans the environment. Make sure the script + is running as freeside, or setuid freeside. Opens a + connection to the database. Swaps real and effective UIDs. + Runs any defined callbacks (see below). Returns the DBI database handle (usually you don't need this). + cgisuidsetup CGI_object + Stores the CGI (see the CGI manpage) object for later use. + (CGI::Base is depriciated) Runs adminsuidsetup. + + cgi Returns the CGI (see the CGI manpage) object. + dbh Returns the DBI database handle. datasrc Returns the DBI data source. getotaker - Returns the current Freeside user. Currently that means the - CGI REMOTE_USER, or 'freeside'. + Returns the current Freeside user. + + cgisetotaker + Sets and returns the CGI REMOTE_USER. $cgi should be defined + as a CGI.pm object. Support for CGI::Base and derived + classes is depriciated. checkeuid Returns true if effective UID is that of the freeside user. @@ -44,14 +55,39 @@ SUBROUTINES swapuid Swaps real and effective UIDs. + getsecrets [ USER ] + Sets the user to USER, if supplied. Sets and returns the DBI + datasource, username and password for this user from the + `/usr/local/etc/freeside/mapsecrets' file. + +CALLBACKS + Warning: this interface is likely to change in future releases. + + A package can install a callback to be run in adminsuidsetup by + putting a coderef into the hash %FS::UID::callback : + + $coderef = sub { warn "Hi, I'm returning your call!" }; + $FS::UID::callback{'Package::Name'}; + +VERSION + $Id: UID.txt,v 1.4 1999-04-08 13:39:31 ivan Exp $ + BUGS + Too many package-global variables. + Not OO. No capabilities yet. When mod_perl and Authen::DBI are implemented, cgisuidsetup will go away as well. + Goes through contortions to support non-OO syntax with multiple + datasrc's. + + Callbacks are inelegant. + SEE ALSO - the FS::Record manpage, the CGI::Base manpage, the DBI manpage + the FS::Record manpage, the CGI manpage, the DBI manpage, + config.html from the base documentation. HISTORY ivan@voicenet.com 97-jun-4 - 9 untaint otaker ivan@voicenet.com @@ -77,3 +113,28 @@ HISTORY pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup, inlined suidsetup ivan@sisd.com 98-sep-12 + $Log: UID.txt,v $ + Revision 1.4 1999-04-08 13:39:31 ivan + convert from pod for 1.2.0 release + Revision 1.8 1999/02/23 07:23:23 ivan oops, + don't comment out &swapuid in &adminsuidsetup! + + Revision 1.7 1999/01/18 09:22:40 ivan changes to track email + addresses for email invoicing + + Revision 1.6 1998/11/15 05:27:48 ivan bugfix for new + configuration layout + + Revision 1.5 1998/11/15 00:51:51 ivan eliminated some warnings + on certain fatal errors (well, it is less confusing) + + Revision 1.4 1998/11/13 09:56:52 ivan change configuration file + layout to support multiple distinct databases (with own set of + config files, export, etc.) + + Revision 1.3 1998/11/08 10:45:42 ivan got sub cgi for FS::CGI + + Revision 1.2 1998/11/08 09:38:43 ivan cgisuidsetup complains if + you pass it a isa CGI::Base instead of an isa CGI (first step in + migrating from CGI-modules to CGI.pm) + diff --git a/htdocs/docs/man/agent.txt b/htdocs/docs/man/agent.txt index b0317f6f7..13a4f0c4b 100644 --- a/htdocs/docs/man/agent.txt +++ b/htdocs/docs/man/agent.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::agent; - $record = create FS::agent \%hash; - $record = create FS::agent { 'column' => 'value' }; + $record = new FS::agent \%hash; + $record = new FS::agent { 'column' => 'value' }; $error = $record->insert; @@ -27,7 +27,7 @@ DESCRIPTION prog - For future use. freq - For future use. METHODS - create HASHREF + new HASHREF Creates a new agent. To add the agent to the database, see the section on "insert". @@ -49,9 +49,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: agent.txt,v 1.3 1999-04-08 13:39:31 ivan Exp $ +BUGS SEE ALSO the FS::Record manpage, the FS::agent_type manpage, the FS::cust_main manpage, schema.html from the base documentation. diff --git a/htdocs/docs/man/agent_type.txt b/htdocs/docs/man/agent_type.txt index ea1edec0c..5983fee88 100644 --- a/htdocs/docs/man/agent_type.txt +++ b/htdocs/docs/man/agent_type.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::agent_type; - $record = create FS::agent_type \%hash; - $record = create FS::agent_type { 'column' => 'value' }; + $record = new FS::agent_type \%hash; + $record = new FS::agent_type { 'column' => 'value' }; $error = $record->insert; @@ -27,7 +27,7 @@ DESCRIPTION typenum - primary key (assigned automatically for new agent types) atype - Text name of this agent type METHODS - create HASHREF + new HASHREF Creates a new agent type. To add the agent type to the database, see the section on "insert". @@ -49,9 +49,10 @@ METHODS If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: agent_type.txt,v 1.3 1999-04-08 13:39:31 ivan Exp $ +BUGS SEE ALSO the FS::Record manpage, the FS::agent manpage, the FS::type_pkgs manpage, the FS::cust_main manpage, the FS::part_pkg manpage, @@ -70,3 +71,9 @@ HISTORY pod, added check in delete ivan@sisd.com 98-sep-21 + $Log: agent_type.txt,v $ + Revision 1.3 1999-04-08 13:39:31 ivan + convert from pod for 1.2.0 release + Revision 1.2 1998/12/29 11:59:35 ivan + mostly properly OO, some work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/cust_bill.txt b/htdocs/docs/man/cust_bill.txt index 9762dd3ca..c11840117 100644 --- a/htdocs/docs/man/cust_bill.txt +++ b/htdocs/docs/man/cust_bill.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_bill; - $record = create FS::cust_bill \%hash; - $record = create FS::cust_bill { 'column' => 'value' }; + $record = new FS::cust_bill \%hash; + $record = new FS::cust_bill { 'column' => 'value' }; $error = $record->insert; @@ -41,7 +41,7 @@ DESCRIPTION printed - how many times this invoice has been printed automatically (see the section on "collect" in the FS::cust_main manpage). METHODS - create HASHREF + new HASHREF Creates a new invoice. To add the invoice to the database, see the section on "insert". Invoices are normally created by calling the bill method of a customer object (see the @@ -105,24 +105,19 @@ METHODS manpage. Also see the Time::Local manpage and the Date::Parse manpage for conversion functions. +VERSION + $Id: cust_bill.txt,v 1.4 1999-04-08 13:39:31 ivan Exp $ + BUGS The delete method. - It doesn't properly override FS::Record yet. - - print_text formatting (and some logic :/) is in source as a - format declaration, which needs to be slurped in from a file. - the fork is rather kludgy as well. It could be cleaned with - swrite from man perlform, and the picture could be put in a - /var/spool/freeside/conf file. Also number of lines ($=). + print_text formatting (and some logic :/) is in source, but + needs to be slurped in from a file. Also number of lines ($=). missing print_ps for a nice postscript copy (maybe HylaFAX- cover-page-style or something similar so the look can be completely customized?) - There is an off-by-one error in print_text which causes a visual - error: "Page 1 of 2" printed on some single-page invoices? - SEE ALSO the FS::Record manpage, the FS::cust_main manpage, the FS::cust_pay manpage, the FS::cust_bill_pkg manpage, the @@ -138,3 +133,25 @@ HISTORY pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20 + $Log: cust_bill.txt,v $ + Revision 1.4 1999-04-08 13:39:31 ivan + convert from pod for 1.2.0 release + Revision 1.7 1999/02/09 09:55:05 ivan + invoices show line items for each service in a package (see the + label method of FS::cust_svc) + + Revision 1.6 1999/01/25 12:26:07 ivan yet more mod_perl stuff + + Revision 1.5 1999/01/18 21:58:03 ivan esthetic: eq and ne were + used in a few places instead of == and != + + Revision 1.4 1998/12/29 11:59:36 ivan mostly properly OO, some + work still to be done with svc_ stuff + + Revision 1.3 1998/11/13 09:56:53 ivan change configuration file + layout to support multiple distinct databases (with own set of + config files, export, etc.) + + Revision 1.2 1998/11/07 10:24:24 ivan don't use depriciated + FS::Bill and FS::Invoice, other miscellania + diff --git a/htdocs/docs/man/cust_bill_pkg.txt b/htdocs/docs/man/cust_bill_pkg.txt index 1ca4b8cca..d725c941e 100644 --- a/htdocs/docs/man/cust_bill_pkg.txt +++ b/htdocs/docs/man/cust_bill_pkg.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_bill_pkg; - $record = create FS::cust_bill_pkg \%hash; - $record = create FS::cust_bill_pkg { 'column' => 'value' }; + $record = new FS::cust_bill_pkg \%hash; + $record = new FS::cust_bill_pkg { 'column' => 'value' }; $error = $record->insert; @@ -32,7 +32,7 @@ DESCRIPTION functions. METHODS - create HASHREF + new HASHREF Creates a new line item. To add the line item to the database, see the section on "insert". Line items are normally created by calling the bill method of a customer @@ -57,9 +57,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert method. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: cust_bill_pkg.txt,v 1.3 1999-04-08 13:39:31 ivan Exp $ +BUGS SEE ALSO the FS::Record manpage, the FS::cust_bill manpage, the FS::cust_pkg manpage, the FS::cust_main manpage, schema.html diff --git a/htdocs/docs/man/cust_credit.txt b/htdocs/docs/man/cust_credit.txt index 84591ee81..c26c1fbd6 100644 --- a/htdocs/docs/man/cust_credit.txt +++ b/htdocs/docs/man/cust_credit.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_credit; - $record = create FS::cust_credit \%hash; - $record = create FS::cust_credit { 'column' => 'value' }; + $record = new FS::cust_credit \%hash; + $record = new FS::cust_credit { 'column' => 'value' }; $error = $record->insert; @@ -30,7 +30,7 @@ DESCRIPTION otaker - order taker (assigned automatically, see the FS::UID manpage) reason - text METHODS - create HASHREF + new HASHREF Creates a new credit. To add the credit to the database, see the section on "insert". @@ -59,11 +59,12 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. +VERSION + $Id: cust_credit.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ + BUGS The delete method. - It doesn't properly override FS::Record yet. - SEE ALSO the FS::Record manpage, the FS::cust_refund manpage, the FS::cust_bill manpage, schema.html from the base documentation. @@ -73,3 +74,15 @@ HISTORY pod, otaker from FS::UID ivan@sisd.com 98-sep-21 + $Log: cust_credit.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.4 1999/01/25 12:26:08 ivan + yet more mod_perl stuff + + Revision 1.3 1999/01/18 21:58:04 ivan esthetic: eq and ne were + used in a few places instead of == and != + + Revision 1.2 1998/12/29 11:59:38 ivan mostly properly OO, some + work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/cust_main.txt b/htdocs/docs/man/cust_main.txt index df7848744..bef2b9d94 100644 --- a/htdocs/docs/man/cust_main.txt +++ b/htdocs/docs/man/cust_main.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_main; - $record = create FS::cust_main \%hash; - $record = create FS::cust_main { 'column' => 'value' }; + $record = new FS::cust_main \%hash; + $record = new FS::cust_main { 'column' => 'value' }; $error = $record->insert; @@ -58,7 +58,7 @@ DESCRIPTION tax - tax exempt, empty or `Y' otaker - order taker (assigned automatically, see the FS::UID manpage) METHODS - create HASHREF + new HASHREF Creates a new customer. To add the customer to the database, see the section on "insert". @@ -151,24 +151,52 @@ METHODS Returns the balance for this customer (total owed minus total credited). -BUGS - The delete method. + invoicing_list [ ARRAYREF ] + If an arguement is given, sets these email addresses as + invoice recipients (see the FS::cust_main_invoice manpage). + Errors are not fatal and are not reported (except as + warnings), so use check_invoicing_list first. + + Returns a list of email addresses (with svcnum entries + expanded). + + Note: You can clear the invoicing list by passing an empty + ARRAYREF. You can check it without disturbing anything by + passing nothing. - It doesn't properly override FS::Record yet. + This interface may change in the future. - hfields should be removed. + check_invoicing_list ARRAYREF + Checks these arguements as valid input for the + invoicing_list method. If there is an error, returns the + error, otherwise returns false. + +VERSION + $Id: cust_main.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $ + +BUGS + The delete method. Bill and collect options should probably be passed as references instead of a list. CyberCash v2 forces us to define some variables in package main. + There should probably be a configuration file with a list of + allowed credit card types. + + CyberCash is the only processor. + + No multiple currency support (probably a larger project than + just this module). + SEE ALSO the FS::Record manpage, the FS::cust_pkg manpage, the FS::cust_bill manpage, the FS::cust_credit manpage the FS::cust_pay_batch manpage, the FS::agent manpage, the FS::part_referral manpage, the FS::cust_main_county manpage, the - FS::UID manpage, schema.html from the base documentation. + FS::cust_main_invoice manpage, the FS::UID manpage, schema.html + from the base documentation. HISTORY ivan@voicenet.com 97-jul-28 @@ -198,3 +226,53 @@ HISTORY cybercash v3 support, don't need to import FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21 + $Log: cust_main.txt,v $ + Revision 1.4 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.16 1999/04/07 14:32:19 ivan + more &invoicing_list logic to skip searches when there is no + custnum + + Revision 1.15 1999/04/07 13:41:54 ivan in &invoicing_list, don't + search if there's no custnum yet + + Revision 1.14 1999/03/29 12:06:15 ivan buglet in email invoices + fixed + + Revision 1.13 1999/02/28 20:09:03 ivan allow spaces in zip + codes, for (at least) canada. pointed out by Clayton Gray + <clgray@bcgroup.net> + + Revision 1.12 1999/02/27 21:24:22 ivan parse paydate correctly + for cybercash + + Revision 1.11 1999/02/23 08:09:27 ivan beginnings of one-screen + new customer entry and some other miscellania + + Revision 1.10 1999/01/25 12:26:09 ivan yet more mod_perl stuff + + Revision 1.9 1999/01/18 09:22:41 ivan changes to track email + addresses for email invoicing + + Revision 1.8 1998/12/29 11:59:39 ivan mostly properly OO, some + work still to be done with svc_ stuff + + Revision 1.7 1998/12/16 09:58:52 ivan library support for + editing email invoice destinations (not in sub collect yet) + + Revision 1.6 1998/11/18 09:01:42 ivan i18n! i18n! + + Revision 1.5 1998/11/15 11:23:14 ivan use FS::table_name for all + searches to eliminate warnings, emit state/county when they + don't match + + Revision 1.4 1998/11/15 05:30:48 ivan bugfix for new config + layout + + Revision 1.3 1998/11/13 09:56:54 ivan change configuration file + layout to support multiple distinct databases (with own set of + config files, export, etc.) + + Revision 1.2 1998/11/07 10:24:25 ivan don't use depriciated + FS::Bill and FS::Invoice, other miscellania + diff --git a/htdocs/docs/man/cust_main_county.txt b/htdocs/docs/man/cust_main_county.txt index 8e99397cc..9a4a60e33 100644 --- a/htdocs/docs/man/cust_main_county.txt +++ b/htdocs/docs/man/cust_main_county.txt @@ -5,8 +5,8 @@ NAME SYNOPSIS use FS::cust_main_county; - $record = create FS::cust_main_county \%hash; - $record = create FS::cust_main_county { 'column' => 'value' }; + $record = new FS::cust_main_county \%hash; + $record = new FS::cust_main_county { 'column' => 'value' }; $error = $record->insert; @@ -24,9 +24,10 @@ DESCRIPTION taxnum - primary key (assigned automatically for new tax rates) state county + country tax - percentage METHODS - create HASHREF + new HASHREF Creates a new tax rate. To add the tax rate to the database, see the section on "insert". @@ -48,11 +49,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. - - A country field (and possibly a currency field) should be added. +VERSION + $Id: cust_main_county.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS SEE ALSO the FS::Record manpage, the FS::cust_main manpage, the FS::cust_bill manpage, schema.html from the base documentation. @@ -65,3 +65,12 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: cust_main_county.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1998/12/29 11:59:41 + ivan mostly properly OO, some work still to be done with svc_ + stuff + + Revision 1.2 1998/11/18 09:01:43 ivan i18n! i18n! + diff --git a/htdocs/docs/man/cust_main_invoice.txt b/htdocs/docs/man/cust_main_invoice.txt new file mode 100644 index 000000000..5d50a9f26 --- /dev/null +++ b/htdocs/docs/man/cust_main_invoice.txt @@ -0,0 +1,98 @@ +NAME + FS::cust_main_invoice - Object methods for cust_main_invoice + records + +SYNOPSIS + use FS::cust_main_invoice; + + $record = new FS::cust_main_invoice \%hash; + $record = new FS::cust_main_invoice { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $email_address = $record->address; + +DESCRIPTION + An FS::cust_main_invoice object represents an invoice + destination. FS::cust_main_invoice inherits from FS::Record. The + following fields are currently supported: + + destnum - primary key + custnum - customer (see the FS::cust_main manpage) + 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) +METHODS + new HASHREF + Creates a new invoice destination. To add the invoice + destination to the database, see the section on "insert". + + Note that this stores the hash reference, not a distinct + copy of the hash it points to. You can ask the object for a + copy with the *hash* method. + + insert + Adds this record to the database. If there is an error, + returns the error, otherwise returns false. + + delete + Delete this record from the database. + + replace OLD_RECORD + Replaces the OLD_RECORD with this one in the database. If + there is an error, returns the error, otherwise returns + false. + + check + Checks all fields to make sure this is a valid invoice + destination. If there is an error, returns the error, + otherwise returns false. Called by the insert and repalce + methods. + + checkdest + Checks the dest field only. + + address + Returns the literal email address for this record (or + `POST'). + +VERSION + $Id: cust_main_invoice.txt,v 1.1 1999-04-08 13:39:32 ivan Exp $ + +BUGS +SEE ALSO + the FS::Record manpage, the FS::cust_main manpage + +HISTORY + ivan@voicenet.com 97-jul-1 + + added hfields ivan@sisd.com 97-nov-13 + + $Log: cust_main_invoice.txt,v $ + Revision 1.1 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.6 1999/01/25 12:26:10 + ivan yet more mod_perl stuff + + Revision 1.5 1999/01/18 21:58:05 ivan esthetic: eq and ne were + used in a few places instead of == and != + + Revision 1.4 1999/01/18 09:22:42 ivan changes to track email + addresses for email invoicing + + Revision 1.3 1998/12/29 11:59:42 ivan mostly properly OO, some + work still to be done with svc_ stuff + + Revision 1.2 1998/12/16 09:58:53 ivan library support for + editing email invoice destinations (not in sub collect yet) + + Revision 1.1 1998/12/16 07:40:02 ivan new table + + Revision 1.3 1998/11/15 04:33:00 ivan updates for newest versoin + + Revision 1.2 1998/11/15 03:48:49 ivan update for current version + diff --git a/htdocs/docs/man/cust_pay.txt b/htdocs/docs/man/cust_pay.txt index 9f28d0822..14843d022 100644 --- a/htdocs/docs/man/cust_pay.txt +++ b/htdocs/docs/man/cust_pay.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_pay; - $record = create FS::cust_pay \%hash; - $record = create FS::cust_pay { 'column' => 'value' }; + $record = new FS::cust_pay \%hash; + $record = new FS::cust_pay { 'column' => 'value' }; $error = $record->insert; @@ -29,7 +29,7 @@ DESCRIPTION payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username) paybatch - text field for tracking card processing METHODS - create HASHREF + new HASHREF Creates a new payment. To add the payment to the databse, see the section on "insert". @@ -48,9 +48,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert method. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: cust_pay.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS Delete and replace methods. SEE ALSO @@ -64,3 +65,12 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: cust_pay.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1999/01/25 12:26:11 ivan yet + more mod_perl stuff + + Revision 1.2 1998/12/29 11:59:43 ivan mostly properly OO, some + work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/cust_pay_batch.txt b/htdocs/docs/man/cust_pay_batch.txt new file mode 100644 index 000000000..2d6267843 --- /dev/null +++ b/htdocs/docs/man/cust_pay_batch.txt @@ -0,0 +1,96 @@ +NAME + FS::cust_pay_batch - Object methods for batch cards + +SYNOPSIS + use FS::cust_pay_batch; + + $record = new FS::cust_pay_batch \%hash; + $record = new FS::cust_pay_batch { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +DESCRIPTION + An FS::cust_pay_batch object represents a credit card + transaction ready to be batched (sent to a processor). + FS::cust_pay_batch inherits from FS::Record. Typically called by + the collect method of an FS::cust_main object. The following + fields are currently supported: + + trancode - 77 for charges + cardnum + exp - card expiration + amount + invnum - invoice + custnum - customer + payname - name on card + first - name + last - name + address1 + address2 + city + state + zip + country +METHODS + new HASHREF + Creates a new record. To add the record to the database, see + the section on "insert". + + Note that this stores the hash reference, not a distinct + copy of the hash it points to. You can ask the object for a + copy with the *hash* method. + + insert + Adds this record to the database. If there is an error, + returns the error, otherwise returns false. + + delete + Delete this record from the database. If there is an error, + returns the error, otherwise returns false. + + replace OLD_RECORD + #inactive # #Replaces the OLD_RECORD with this one in the + database. If there is an error, #returns the error, + otherwise returns false. + + check + Checks all fields to make sure this is a valid transaction. + If there is an error, returns the error, otherwise returns + false. Called by the insert and repalce methods. + +VERSION + $Id: cust_pay_batch.txt,v 1.1 1999-04-08 13:39:32 ivan Exp $ + +BUGS + There should probably be a configuration file with a list of + allowed credit card types. + +SEE ALSO + the FS::cust_main manpage, the FS::Record manpage + +HISTORY + ivan@voicenet.com 97-jul-1 + + added hfields ivan@sisd.com 97-nov-13 + + $Log: cust_pay_batch.txt,v $ + Revision 1.1 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1998/12/29 11:59:44 + ivan mostly properly OO, some work still to be done with svc_ + stuff + + Revision 1.2 1998/11/18 09:01:44 ivan i18n! i18n! + + Revision 1.1 1998/11/15 05:19:58 ivan long overdue + + Revision 1.3 1998/11/15 04:33:00 ivan updates for newest versoin + + Revision 1.2 1998/11/15 03:48:49 ivan update for current version + diff --git a/htdocs/docs/man/cust_pkg.txt b/htdocs/docs/man/cust_pkg.txt index 5409083d8..395403192 100644 --- a/htdocs/docs/man/cust_pkg.txt +++ b/htdocs/docs/man/cust_pkg.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_pkg; - $record = create FS::cust_pkg \%hash; - $record = create FS::cust_pkg { 'column' => 'value' }; + $record = new FS::cust_pkg \%hash; + $record = new FS::cust_pkg { 'column' => 'value' }; $error = $record->insert; @@ -21,6 +21,10 @@ SYNOPSIS $error = $record->unsuspend; + $part_pkg = $record->part_pkg; + + @labels = $record->labels; + $error = FS::cust_pkg::order( $custnum, \@pkgparts ); $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); @@ -44,7 +48,7 @@ DESCRIPTION conversion functions. METHODS - create HASHREF + new HASHREF Create a new billing item. To add the item to the database, see the section on "insert". @@ -53,13 +57,26 @@ METHODS If there is an error, returns the error, otherwise returns false. + sub insert { my $self = shift; + + # custnum might not have have been defined in sub check (for one-shot new + # customers), so check it here instead + + my $error = $self->ut_number('custnum'); + return $error if $error + + return "Unknown customer" + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); + + $self->SUPER::insert; + + } + delete Currently unimplemented. You don't want to delete billing items, because there would then be no record the customer ever purchased the item. Instead, see the cancel method. - sub delete { return "Can't delete cust_pkg records!"; } - replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns @@ -68,7 +85,8 @@ METHODS Currently, custnum, setup, bill, susp, expire, and cancel may be changed. - pkgpart may not be changed, but see the order subroutine. + Changing pkgpart may have disasterous effects. See the order + subroutine. setup and bill are normally updated by calling the bill method of a customer object (see the FS::cust_main manpage). @@ -108,6 +126,15 @@ METHODS If there is an error, returns the error, otherwise returns false. + part_pkg + Returns the definition for this billing item, as an + FS::part_pkg object (see L<FS::part_pkg). + + labels + Returns a list of lists, calling the label method for all + services (see the FS::cust_svc manpage) of this billing + item. + SUBROUTINES order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ] CUSTNUM is a customer (see the FS::cust_main manpage) @@ -122,9 +149,10 @@ SUBROUTINES items. An error is returned if this is not possible (see the FS::pkg_svc manpage). -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: cust_pkg.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $ +BUGS sub order is not OO. Perhaps it should be moved to FS::cust_main and made so? @@ -135,6 +163,13 @@ BUGS defines a standard method to pass dates to the recur_prog expression, it should do so. + FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via + 'use' at compile time, rather than via 'require' in sub { setup, + suspend, unsuspend, cancel } because they use %FS::UID::callback + to load configuration values. Probably need a subroutine which + decides what to do based on whether or not we've fetched the + user yet, rather than a hash. See FS::UID and the TODO. + SEE ALSO the FS::Record manpage, the FS::cust_main manpage, the FS::part_pkg manpage, the FS::cust_svc manpage , the FS::pkg_svc @@ -148,3 +183,30 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: cust_pkg.txt,v $ + Revision 1.4 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.9 1999/03/29 01:11:51 ivan use + FS::type_pkgs + + Revision 1.8 1999/03/25 13:48:14 ivan allow empty custnum in sub + check (but call that an error in sub insert), for one-screen new + customer entry + + Revision 1.7 1999/02/09 09:55:06 ivan invoices show line items + for each service in a package (see the label method of + FS::cust_svc) + + Revision 1.6 1999/01/25 12:26:12 ivan yet more mod_perl stuff + + Revision 1.5 1999/01/18 21:58:07 ivan esthetic: eq and ne were + used in a few places instead of == and != + + Revision 1.4 1998/12/29 11:59:45 ivan mostly properly OO, some + work still to be done with svc_ stuff + + Revision 1.3 1998/11/15 13:01:35 ivan allow pkgpart changing + (for per-customer custom pricing). warn about it in doc + + Revision 1.2 1998/11/12 03:42:45 ivan added label method + diff --git a/htdocs/docs/man/cust_refund.txt b/htdocs/docs/man/cust_refund.txt index 392a0b57a..a982ca610 100644 --- a/htdocs/docs/man/cust_refund.txt +++ b/htdocs/docs/man/cust_refund.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_refund; - $record = create FS::cust_refund \%hash; - $record = create FS::cust_refund { 'column' => 'value' }; + $record = new FS::cust_refund \%hash; + $record = new FS::cust_refund { 'column' => 'value' }; $error = $record->insert; @@ -28,7 +28,7 @@ DESCRIPTION payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username) otaker - order taker (assigned automatically, see the FS::UID manpage) METHODS - create HASHREF + new HASHREF Creates a new refund. To add the refund to the database, see the section on "insert". @@ -47,9 +47,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert method. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: cust_refund.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS Delete and replace methods. SEE ALSO @@ -64,3 +65,12 @@ HISTORY pod and finish up ivan@sisd.com 98-sep-21 + $Log: cust_refund.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1999/01/25 12:26:13 ivan + yet more mod_perl stuff + + Revision 1.2 1998/12/29 11:59:46 ivan mostly properly OO, some + work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/cust_svc.txt b/htdocs/docs/man/cust_svc.txt index d863ea852..206d9d34b 100644 --- a/htdocs/docs/man/cust_svc.txt +++ b/htdocs/docs/man/cust_svc.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::cust_svc; - $record = create FS::cust_svc \%hash - $record = create FS::cust_svc { 'column' => 'value' }; + $record = new FS::cust_svc \%hash + $record = new FS::cust_svc { 'column' => 'value' }; $error = $record->insert; @@ -15,6 +15,8 @@ SYNOPSIS $error = $record->check; + ($label, $value) = $record->label; + DESCRIPTION An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record. The following fields are currently supported: @@ -23,7 +25,7 @@ DESCRIPTION pkgnum - Package (see the FS::cust_pkg manpage) svcpart - Service definition (see the FS::part_svc manpage) METHODS - create HASHREF + new HASHREF Creates a new service. To add the refund to the database, see the section on "insert". Services are normally created by creating FS::svc_ objects (see the FS::svc_acct manpage, @@ -51,12 +53,24 @@ METHODS there is an error, returns the error, otehrwise returns false. Called by the insert and replace methods. + label + Returns a list consisting of: - The name of this service + (from part_svc) - A meaningful identifier (username, domain, + or mail alias) - The table name (i.e. svc_domain) for this + service + +VERSION + $Id: cust_svc.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $ + BUGS Behaviour of changing the svcpart of cust_svc records is undefined and should possibly be prohibited, and pkg_svc records are not checked. - pkg_svc records are not checket in general (here). + pkg_svc records are not checked in general (here). + + Deleting this record doesn't check or delete the svc_* record + associated with this record. SEE ALSO the FS::Record manpage, the FS::cust_pkg manpage, the @@ -70,3 +84,16 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: cust_svc.txt,v $ + Revision 1.4 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.5 1998/12/29 11:59:47 ivan + mostly properly OO, some work still to be done with svc_ stuff + + Revision 1.4 1998/11/12 07:58:15 ivan added svcdb to label + + Revision 1.3 1998/11/12 03:45:38 ivan use FS::table_name for all + tables qsearch()'ed + + Revision 1.2 1998/11/12 03:32:46 ivan added label method + diff --git a/htdocs/docs/man/dbdef_column.txt b/htdocs/docs/man/dbdef_column.txt index 93e239517..6747a328c 100644 --- a/htdocs/docs/man/dbdef_column.txt +++ b/htdocs/docs/man/dbdef_column.txt @@ -46,16 +46,17 @@ METHODS line [ $datasrc ] Returns an SQL column definition. - If passed a DBI $datasrc specifying the DBD::mysql manpage, - will use MySQL-specific syntax. Non-standard syntax for - other engines (if applicable) may also be supported in the - future. + If passed a DBI $datasrc specifying the DBD::mysql manpage + or the DBD::Pg manpage, will use engine-specific syntax. BUGS SEE ALSO the FS::dbdef_table manpage, the FS::dbdef manpage, the DBI manpage +VERSION + $Id: dbdef_column.txt,v 1.5 1999-04-08 13:39:32 ivan Exp $ + HISTORY class for dealing with column definitions @@ -67,3 +68,12 @@ HISTORY mySQL-specific hack for null (what should be default?) ivan@sisd.com 98-jun-2 + $Log: dbdef_column.txt,v $ + Revision 1.5 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1998/10/13 13:04:17 ivan + fixed doc to indicate Pg specific syntax too + + Revision 1.2 1998/10/12 23:40:28 ivan added Pg-specific + behaviour in sub line + diff --git a/htdocs/docs/man/dbdef_table.txt b/htdocs/docs/man/dbdef_table.txt index 25e010d8b..1a1887156 100644 --- a/htdocs/docs/man/dbdef_table.txt +++ b/htdocs/docs/man/dbdef_table.txt @@ -75,6 +75,9 @@ SEE ALSO FS::dbdef_index manpage, the FS::dbdef_unique manpage, the DBI manpage +VERSION + $Id: dbdef_table.txt,v 1.5 1999-04-08 13:39:32 ivan Exp $ + HISTORY class for dealing with table definitions @@ -92,3 +95,9 @@ HISTORY pod ivan@sisd.com 98-sep-24 + $Log: dbdef_table.txt,v $ + Revision 1.5 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.2 1998/10/14 07:05:06 ivan + 1.1.4 release, fix postgresql + diff --git a/htdocs/docs/man/index.html b/htdocs/docs/man/index.html index 4f33dd485..79fda2e04 100644 --- a/htdocs/docs/man/index.html +++ b/htdocs/docs/man/index.html @@ -11,7 +11,9 @@ <li><a href="cust_credit.txt">FS::cust_credit</a> <li><a href="cust_main.txt">FS::cust_main</a> <li><a href="cust_main_county.txt">FS::cust_main_county</a> +<li><a href="cust_main_invoice.txt">FS::cust_main_invoice</a> <li><a href="cust_pay.txt">FS::cust_pay</a> +<li><a href="cust_pay_batch.txt">FS::cust_pay_batch</a> <li><a href="cust_pkg.txt">FS::cust_pkg</a> <li><a href="cust_refund.txt">FS::cust_refund</a> <li><a href="cust_svc.txt">FS::cust_svc</a> @@ -19,6 +21,7 @@ <li><a href="part_referral.txt">FS::part_referral</a> <li><a href="part_svc.txt">FS::part_svc</a> <li><a href="pkg_svc.txt">FS::pkg_svc</a> +<li><a href="svc_Common.txt">FS::svc_Common</a> <li><a href="svc_acct.txt">FS::svc_acct</a> <li><a href="svc_acct_pop.txt">FS::svc_acct_pop</a> <li><a href="svc_acct_sm.txt">FS::svc_acct_sm</a> diff --git a/htdocs/docs/man/part_pkg.txt b/htdocs/docs/man/part_pkg.txt index dc1bce423..02aa109a0 100644 --- a/htdocs/docs/man/part_pkg.txt +++ b/htdocs/docs/man/part_pkg.txt @@ -4,8 +4,10 @@ NAME SYNOPSIS use FS::part_pkg; - $record = create FS::part_pkg \%hash - $record = create FS::part_pkg { 'column' => 'value' }; + $record = new FS::part_pkg \%hash + $record = new FS::part_pkg { 'column' => 'value' }; + + $custom_record = $template_record->clone; $error = $record->insert; @@ -16,7 +18,7 @@ SYNOPSIS $error = $record->check; DESCRIPTION - An FS::part_pkg represents a billing item definition. + An FS::part_pkg object represents a billing item definition. FS::part_pkg inherits from FS::Record. The following fields are currently supported: @@ -31,11 +33,18 @@ DESCRIPTION are not yet defined. METHODS - create HASHREF + new HASHREF Creates a new billing item definition. To add the billing item definition to the database, see the section on "insert". + clone + An alternate constructor. Creates a new billing item + definition by duplicating an existing definition. A new + pkgpart is assigned and `(CUSTOM) ' is prepended to the + comment field. To add the billing item definition to the + database, see the section on "insert". + insert Adds this billing item definition to the database. If there is an error, returns the error, otherwise returns false. @@ -53,6 +62,9 @@ METHODS otherwise returns false. Called by the insert and replace methods. +VERSION + $Id: part_pkg.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ + BUGS It doesn't properly override FS::Record yet. @@ -71,3 +83,11 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: part_pkg.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.5 1998/12/31 01:04:16 ivan doc + + Revision 1.3 1998/11/15 13:00:15 ivan bugfix in clone method, + clone method doc clarification + diff --git a/htdocs/docs/man/part_referral.txt b/htdocs/docs/man/part_referral.txt index 534996323..fbc141c45 100644 --- a/htdocs/docs/man/part_referral.txt +++ b/htdocs/docs/man/part_referral.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::part_referral; - $record = create FS::part_referral \%hash - $record = create FS::part_referral { 'column' => 'value' }; + $record = new FS::part_referral \%hash + $record = new FS::part_referral { 'column' => 'value' }; $error = $record->insert; @@ -25,7 +25,7 @@ DESCRIPTION refnum - primary key (assigned automatically for new referrals) referral - Text name of this referral METHODS - create HASHREF + new HASHREF Creates a new referral. To add the referral to the database, see the section on "insert". @@ -45,9 +45,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: part_referral.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS The delete method is unimplemented. SEE ALSO @@ -61,3 +62,9 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: part_referral.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.2 1998/12/29 11:59:49 ivan + mostly properly OO, some work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/part_svc.txt b/htdocs/docs/man/part_svc.txt index 680944e2f..71af2c4f4 100644 --- a/htdocs/docs/man/part_svc.txt +++ b/htdocs/docs/man/part_svc.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::part_svc; - $record = create FS::part_referral \%hash - $record = create FS::part_referral { 'column' => 'value' }; + $record = new FS::part_referral \%hash + $record = new FS::part_referral { 'column' => 'value' }; $error = $record->insert; @@ -27,7 +27,7 @@ DESCRIPTION *svcdb*__*field* - Default or fixed value for *field* in *svcdb*. *svcdb*__*field*_flag - defines *svcdb*__*field* action: null, `D' for default, or `F' for fixed METHODS - create HASHREF + new HASHREF Creates a new service definition. To add the service definition to the database, see the section on "insert". @@ -48,11 +48,15 @@ METHODS otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: part_svc.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS Delete is unimplemented. + The list of svc_* tables is hardcoded. When svc_acct_pop is + renamed, this should be fixed. + SEE ALSO the FS::Record manpage, the FS::part_pkg manpage, the FS::pkg_svc manpage, the FS::cust_svc manpage, the FS::svc_acct @@ -67,3 +71,12 @@ HISTORY pod ivan@sisd.com 98-sep-21 + $Log: part_svc.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + 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 + diff --git a/htdocs/docs/man/pkg_svc.txt b/htdocs/docs/man/pkg_svc.txt index bde0043f1..d921642be 100644 --- a/htdocs/docs/man/pkg_svc.txt +++ b/htdocs/docs/man/pkg_svc.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::pkg_svc; - $record = create FS::pkg_svc \%hash; - $record = create FS::pkg_svc { 'column' => 'value' }; + $record = new FS::pkg_svc \%hash; + $record = new FS::pkg_svc { 'column' => 'value' }; $error = $record->insert; @@ -26,7 +26,7 @@ DESCRIPTION quantity - Quantity of this service definition that this billing item definition includes METHODS - create HASHREF + new HASHREF Create a new record. To add the record to the database, see the section on "insert". @@ -47,9 +47,10 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: pkg_svc.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS SEE ALSO the FS::Record manpage, the FS::part_pkg manpage, the FS::part_svc manpage, schema.html from the base documentation. @@ -59,3 +60,13 @@ HISTORY pod ivan@sisd.com 98-sep-22 + $Log: pkg_svc.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1999/01/18 21:58:08 ivan + esthetic: eq and ne were used in a few places instead of == and + != + + Revision 1.2 1998/12/29 11:59:51 ivan mostly properly OO, some + work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/svc_Common.txt b/htdocs/docs/man/svc_Common.txt new file mode 100644 index 000000000..d63b8f245 --- /dev/null +++ b/htdocs/docs/man/svc_Common.txt @@ -0,0 +1,75 @@ +NAME + FS::svc_Common - Object method for all svc_ records + +SYNOPSIS + use FS::svc_Common; + + @ISA = qw( FS::svc_Common ); + +DESCRIPTION + FS::svc_Common is intended as a base class for table-specific + classes to inherit from, i.e. FS::svc_acct. FS::svc_Common + inherits from FS::Record. + +METHODS + insert + Adds this record to the database. If there is an error, + returns the error, otherwise returns false. + + The additional fields pkgnum and svcpart (see the + FS::cust_svc manpage) should be defined. An FS::cust_svc + record will be created and inserted. + + delete + Deletes this account from the database. If there is an + error, returns the error, otherwise returns false. + + The corresponding FS::cust_svc record will be deleted as + well. + + setfixed + Sets any fixed fields for this service (see the FS::part_svc + manpage). If there is an error, returns the error, otherwise + returns the FS::part_svc object (use ref() to test the + return). Usually called by the check method. + + setdefault + Sets all fields to their defaults (see the FS::part_svc + manpage), overriding their current values. If there is an + error, returns the error, otherwise returns the FS::part_svc + object (use ref() to test the return). + + suspend + unsuspend + cancel + Stubs - return false (no error) so derived classes don't + need to define these methods. Called by the cancel method of + FS::cust_pkg (see the FS::cust_pkg manpage). + +VERSION + $Id: svc_Common.txt,v 1.1 1999-04-08 13:39:32 ivan Exp $ + +BUGS + The setfixed method return value. + + The new method should set defaults from part_svc (like the check + method sets fixed values)? + +SEE ALSO + the FS::Record manpage, the FS::cust_svc manpage, the + FS::part_svc manpage, the FS::cust_pkg manpage, schema.html from + the base documentation. + +HISTORY + $Log: svc_Common.txt,v $ + Revision 1.1 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.3 1999/03/25 13:31:29 ivan + added setdefault method (generalized setfixed method to setx + method) + + Revision 1.2 1999/01/25 12:26:14 ivan yet more mod_perl stuff + + Revision 1.1 1998/12/30 00:30:45 ivan svc_ stuff is more + properly OO - has a common superclass FS::svc_Common + diff --git a/htdocs/docs/man/svc_acct.txt b/htdocs/docs/man/svc_acct.txt index 1c9caf5fb..7eb5be47b 100644 --- a/htdocs/docs/man/svc_acct.txt +++ b/htdocs/docs/man/svc_acct.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::svc_acct; - $record = create FS::svc_acct \%hash; - $record = create FS::svc_acct { 'column' => 'value' }; + $record = new FS::svc_acct \%hash; + $record = new FS::svc_acct { 'column' => 'value' }; $error = $record->insert; @@ -23,7 +23,7 @@ SYNOPSIS DESCRIPTION An FS::svc_acct object represents an account. FS::svc_acct - inherits from FS::Record. The following fields are currently + inherits from FS::svc_Common. The following fields are currently supported: svcnum - primary key (assigned automatcially for new accounts) @@ -39,7 +39,7 @@ DESCRIPTION slipip - IP address radius_*Radius_Attribute* - *Radius-Attribute* METHODS - create HASHREF + new HASHREF Creates a new account. To add the account to the database, see the section on "insert". @@ -126,19 +126,22 @@ METHODS Sets any fixed values; see the FS::part_svc manpage. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: svc_acct.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $ +BUGS The remote commands should be configurable. - The create method should set defaults from part_svc (like the - check method sets fixed values). + The bits which ssh should fork before doing so. + + The $recref stuff in sub check should be cleaned up. SEE ALSO - the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc - manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the - FS::SSH manpage, the ssh manpage, the FS::svc_acct_pop manpage, - schema.html from the base documentation. + the FS::svc_Common manpage, the FS::Record manpage, the FS::Conf + manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the + FS::cust_pkg manpage, the FS::SSH manpage, the ssh manpage, the + FS::svc_acct_pop manpage, schema.html from the base + documentation. HISTORY ivan@voicenet.com 97-jul-16 - 21 @@ -166,3 +169,21 @@ HISTORY pod and FS::conf ivan@sisd.com 98-sep-22 + $Log: svc_acct.txt,v $ + Revision 1.4 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.7 1999/04/07 14:37:37 ivan use + FS::part_svc and FS::svc_acct_pop to avoid warnings + + Revision 1.6 1999/01/25 12:26:15 ivan yet more mod_perl stuff + + Revision 1.5 1999/01/18 21:58:09 ivan esthetic: eq and ne were + used in a few places instead of == and != + + Revision 1.4 1998/12/30 00:30:45 ivan svc_ stuff is more + properly OO - has a common superclass FS::svc_Common + + Revision 1.2 1998/11/13 09:56:55 ivan change configuration file + layout to support multiple distinct databases (with own set of + config files, export, etc.) + diff --git a/htdocs/docs/man/svc_acct_pop.txt b/htdocs/docs/man/svc_acct_pop.txt index ac0965413..e8629fd47 100644 --- a/htdocs/docs/man/svc_acct_pop.txt +++ b/htdocs/docs/man/svc_acct_pop.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::svc_acct_pop; - $record = create FS::svc_acct_pop \%hash; - $record = create FS::svc_acct_pop { 'column' => 'value' }; + $record = new FS::svc_acct_pop \%hash; + $record = new FS::svc_acct_pop { 'column' => 'value' }; $error = $record->insert; @@ -26,17 +26,17 @@ DESCRIPTION ac - area code exch - exchange METHODS - create HASHREF + new HASHREF Creates a new point of presence (if only it were that easy!). To add the point of presence to the database, see the section on "insert". insert - Adds this point of presence to the databaes. If there is an + Adds this point of presence to the database. If there is an error, returns the error, otherwise returns false. delete - Currently unimplemented. + Removes this point of presence from the database. replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there @@ -47,9 +47,10 @@ METHODS presence. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: svc_acct_pop.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS It should be renamed to part_pop. SEE ALSO @@ -63,3 +64,9 @@ HISTORY pod ivan@sisd.com 98-sep-23 + $Log: svc_acct_pop.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.2 1998/12/29 11:59:53 ivan + mostly properly OO, some work still to be done with svc_ stuff + diff --git a/htdocs/docs/man/svc_acct_sm.txt b/htdocs/docs/man/svc_acct_sm.txt index e9940af9a..dc0773f0f 100644 --- a/htdocs/docs/man/svc_acct_sm.txt +++ b/htdocs/docs/man/svc_acct_sm.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::svc_acct_sm; - $record = create FS::svc_acct_sm \%hash; - $record = create FS::svc_acct_sm { 'column' => 'value' }; + $record = new FS::svc_acct_sm \%hash; + $record = new FS::svc_acct_sm { 'column' => 'value' }; $error = $record->insert; @@ -31,7 +31,7 @@ DESCRIPTION domuid - uid of the target account (see the FS::svc_acct manpage) domuser - virtual username METHODS - create HASHREF + new HASHREF Creates a new virtual mail alias. To add the virtual mail alias to the database, see the section on "insert". @@ -93,11 +93,14 @@ METHODS Sets any fixed values; see the FS::part_svc manpage. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: svc_acct_sm.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ +BUGS The remote commands should be configurable. + The $recref stuff in sub check should be cleaned up. + SEE ALSO the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the diff --git a/htdocs/docs/man/svc_domain.txt b/htdocs/docs/man/svc_domain.txt index 03d3dbc27..939a940ac 100644 --- a/htdocs/docs/man/svc_domain.txt +++ b/htdocs/docs/man/svc_domain.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::svc_domain; - $record = create FS::svc_domain \%hash; - $record = create FS::svc_domain { 'column' => 'value' }; + $record = new FS::svc_domain \%hash; + $record = new FS::svc_domain { 'column' => 'value' }; $error = $record->insert; @@ -23,13 +23,13 @@ SYNOPSIS DESCRIPTION An FS::svc_domain object represents a domain. FS::svc_domain - inherits from FS::Record. The following fields are currently + inherits from FS::svc_Common. The following fields are currently supported: svcnum - primary key (assigned automatically for new accounts) domain METHODS - create HASHREF + new HASHREF Creates a new domain. To add the domain to the database, see the section on "insert". @@ -47,6 +47,13 @@ METHODS A registration or transfer email will be submitted unless $FS::svc_domain::whois_hack is true. + The additional field *email* can be used to manually set the + admin contact email address on this email. Otherwise, the + svc_acct records for this package (see the FS::cust_pkg + manpage) are searched. If there is exactly one svc_acct + record in the same package, it is automatically used. + Otherwise an error is returned. + delete Deletes this domain from the database. If there is an error, returns the error, otherwise returns false. @@ -96,23 +103,26 @@ METHODS submit_internic Submits a registration email for this domain. -BUGS - It doesn't properly override FS::Record yet. +VERSION + $Id: svc_domain.txt,v 1.4 1999-04-08 13:39:32 ivan Exp $ +BUGS All BIND/DNS fields should be included (and exported). - All registries should be supported. + Delete doesn't send a registration template. - Not all configuration access is through FS::Conf! + All registries should be supported. Should change action to a real field. + The $recref stuff in sub check should be cleaned up. + SEE ALSO - the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc - manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the - FS::SSH manpage, the ssh manpage, the dot-qmail manpage, - schema.html from the base documentation, config.html from the - base documentation. + the FS::svc_Common manpage, the FS::Record manpage, the FS::Conf + manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the + FS::cust_pkg manpage, the FS::SSH manpage, the ssh manpage, the + dot-qmail manpage, schema.html from the base documentation, + config.html from the base documentation. HISTORY ivan@voicenet.com 97-jul-21 @@ -129,3 +139,21 @@ HISTORY pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23 + $Log: svc_domain.txt,v $ + Revision 1.4 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.7 1999/04/07 14:40:15 ivan + use all stuff that's qsearch'ed to avoid warnings + + Revision 1.6 1999/01/25 12:26:17 ivan yet more mod_perl stuff + + Revision 1.5 1998/12/30 00:30:47 ivan svc_ stuff is more + properly OO - has a common superclass FS::svc_Common + + Revision 1.3 1998/11/13 09:56:57 ivan change configuration file + layout to support multiple distinct databases (with own set of + config files, export, etc.) + + Revision 1.2 1998/10/14 08:18:21 ivan More informative error + messages and better doc for admin contact email stuff + diff --git a/htdocs/docs/man/type_pkgs.txt b/htdocs/docs/man/type_pkgs.txt index 9822b4802..f575e2041 100644 --- a/htdocs/docs/man/type_pkgs.txt +++ b/htdocs/docs/man/type_pkgs.txt @@ -4,8 +4,8 @@ NAME SYNOPSIS use FS::type_pkgs; - $record = create FS::type_pkgs \%hash; - $record = create FS::type_pkgs { 'column' => 'value' }; + $record = new FS::type_pkgs \%hash; + $record = new FS::type_pkgs { 'column' => 'value' }; $error = $record->insert; @@ -24,7 +24,7 @@ DESCRIPTION typenum - Agent type, see the FS::agent_type manpage pkgpart - Billing item definition, see the FS::part_pkg manpage METHODS - create HASHREF + new HASHREF Create a new record. To add the record to the database, see the section on "insert". @@ -45,6 +45,14 @@ METHODS there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. +VERSION + $Id: type_pkgs.txt,v 1.3 1999-04-08 13:39:32 ivan Exp $ + +BUGS +SEE ALSO + the FS::Record manpage, the FS::agent_type manpage, the + FS::part_pkgs manpage, schema.html from the base documentation. + HISTORY Defines the relation between agent types and pkgparts (Which pkgparts can the different [types of] agents sell?) @@ -53,3 +61,9 @@ HISTORY change to ut_ FS::Record, fixed bugs ivan@sisd.com 97-dec-10 + $Log: type_pkgs.txt,v $ + Revision 1.3 1999-04-08 13:39:32 ivan + convert from pod for 1.2.0 release + Revision 1.2 1998/12/29 11:59:58 ivan + mostly properly OO, some work still to be done with svc_ stuff + diff --git a/htdocs/docs/postgresql.html b/htdocs/docs/postgresql.html new file mode 100755 index 000000000..151081176 --- /dev/null +++ b/htdocs/docs/postgresql.html @@ -0,0 +1,23 @@ +<head> + <title>PostgreSQL notes</title> +</head> +<body> + <h1>PostgreSQL notes</h1> +<p> +PostgreSQL ships by default with a maximum of 31 character column names. If +you use arbitrary RADIUS attributes longer than 9 characters, fs-setup will +fail with `duplicate column' errors (in the part_svc table). +Solution: use a different database +engine, or recompile PostgreSQL with 64 character column names. +</p> +Future versions of Freeside will keep all column names under 31 characters to +avoid this problem. +</p> +<p> +( I've personally been unable to get PostgreSQL working with larger column names, +though the process does look like it should be straightforward. If anyone is +interested in assisting me with this, please get in touch. + -Ivan <a href="mailto:ivan@sisd.com"><ivan@sisd.com</a>> ) +</p> +</body> + diff --git a/htdocs/docs/schema.html b/htdocs/docs/schema.html index 5a296ec83..f50525183 100644 --- a/htdocs/docs/schema.html +++ b/htdocs/docs/schema.html @@ -50,7 +50,9 @@ <li>custnum - primary key <li>agentnum - <a href="#agent">agent</a> <li>refnum - <a href="#part_referral">referral</a> + <li>titlenum - <a href="#part_title">title</a> <li>first - name + <li>middle - name <li>last - name <li>ss - social security number <li>company @@ -70,11 +72,18 @@ <li>tax - tax exempt, Y or null <li>otaker - order taker </ul> + <li><a name="cust_main_invoice">cust_main_invoice</a> - Invoice destinations for email invoices + <ul> + <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 <li>state <li>county + <li>country <li>tax - % rate </ul> <li><a name="cust_pay">cust_pay</a> - Payments @@ -155,6 +164,11 @@ <li><i>table</i>__<i>field</i> - Default or fixed value for <i>field</i> in <i>table</i> <li><i>table</i>__<i>field</i>_flag - null, D or F </ul> + <li><a name="part_title">part_title</a> - Personal titles + <ul> + <li>titlenum - primary key + <li>title - personal title (`Dr.' or `Mr.') + </ul> <li><a name="pkg_svc">pkg_svc</a> <ul> <li>pkgpart - <a href="#part_pkg">Package definition</a> diff --git a/htdocs/docs/trouble.html b/htdocs/docs/trouble.html index 2cf6d4e71..c918138c8 100644 --- a/htdocs/docs/trouble.html +++ b/htdocs/docs/trouble.html @@ -5,7 +5,7 @@ <h1>Troubleshooting</h1> <ul> <li>When troubleshooting the web interface, helpful information is often in your web server's error log. - <li>Internet Explorer will not work with Freeside's HTML interface. + <li>Internet Explorer will not work with Freeside's HTML interface. <b>This may be fixed in >1.2, please report your experiences!</b> <a HREF="http://www.netscape.com">Netscape</a>, <a HREF="http://lynx.browser.org">Lynx</a>, and <a HREF="http://www.cs.indiana.edu/elisp/w3/docs.html">Emacs/W3</a>, @@ -17,7 +17,7 @@ Ambiguous use of value => resolved to "value" => at /usr/lib/perl5/site_perl/File/CounterFile.pm line 132. </pre> This clutters up your log files but is otherwise harmless. Upgrade to the latest File::CounterFile. - <li>If you get an Internal Server Error when adding or editing, but find that the update has occured, and you get something like the following in your web server's error log: + <li><b>(No longer applicable in >1.2!)</b> If you get an Internal Server Error when adding or editing, but find that the update has occured, and you get something like the following in your web server's error log: <pre> access to <i>/your/path</i>/edit/process/<i>some_table</i>.cgi failed for <i>machine.domain.tld</i>, reason: malformed header from script. @@ -31,11 +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/docs/upgrade2.html b/htdocs/docs/upgrade2.html index 4bf7ea45a..7acae48f7 100644 --- a/htdocs/docs/upgrade2.html +++ b/htdocs/docs/upgrade2.html @@ -1,8 +1,8 @@ <head> - <title>Upgrading to 1.1.3</title> + <title>Upgrading to 1.1.4</title> </head> <body> -<h1>Upgrading to 1.1.3 from 1.1.x</h1> +<h1>Upgrading to 1.1.4 from 1.1.x</h1> <ul> <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first. <li>Back up your data and current Freeside installation. diff --git a/htdocs/docs/upgrade3.html b/htdocs/docs/upgrade3.html new file mode 100644 index 000000000..815652aaf --- /dev/null +++ b/htdocs/docs/upgrade3.html @@ -0,0 +1,40 @@ +<head> + <title>Upgrading to 1.2.x</title> +</head> +<body> +<h1>Upgrading to 1.1.x from 1.2.x</h1> +<ul> + <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first. + <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first. + <li>Back up your data and current Freeside installation. + <li>Install the Perl module <a href="http://www.perl.com/CPAN/modules/by-module/String/">String-Approx</a> + <li><a href="config.html">Configuration file</a> location has changed! + <li>Move /var/spool/freeside/dbdef.<i>datasrc</i> to /usr/local/etc/freeside/dbdef.<i>datasrc</i>. + <li>Move /var/spool/freeside/counters to /usr/local/etc/freeside/counters.<i>datasrc</i>. + <li>Move /var/spool/freeside/export to /usr/local/etc/freeside/export.<i>datasrc</i>. + <li>Apply the following changes to your database: +<pre> +<!-- ALTER TABLE cust_main ADD middle varchar(80) NULL; +ALTER TABLE cust_main ADD titlenum int NULL; +-->ALTER TABLE cust_main CHANGE state state varchar(80) NULL; +ALTER TABLE cust_main_county CHANGE state state varchar(80) NULL; +ALTER TABLE cust_main_county ADD country char(2); +ALTER TABLE cust_main CHANGE paydate paydate varchar(10); +UPDATE cust_main SET country = "US" where country IS NULL OR country = ''; +UPDATE cust_main_county SET country = "US" where country IS NULL OR country = ""; +<!--CREATE TABLE part_title ( + titlenum int NOT NULL, + title varchar(80) NOT NULL, + PRIMARY KEY (titlenum) +); +-->CREATE TABLE cust_main_invoice ( + destnum int NOT NULL, + custnum int NOT NULL, + dest varchar(80) NOT NULL, + PRIMARY KEY (destnum), + INDEX ( custnum ) +); +</pre> + <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly. + <li>Copy or symlink htdocs and site_perl to the new copies. +</body> diff --git a/htdocs/edit/agent.cgi b/htdocs/edit/agent.cgi index 5bd116528..5b42095b3 100755 --- a/htdocs/edit/agent.cgi +++ b/htdocs/edit/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: Add/Edit agent (output form) +# $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -9,38 +9,70 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: agent.cgi,v $ +# Revision 1.7 1999-04-07 11:27:50 ivan +# avoid perl's silly arguement not numeric error +# +# Revision 1.6 1999/01/25 12:09:50 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:31 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:21 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:16:57 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/23 07:52:08 ivan +# *** empty log message *** +# use strict; -use CGI::Base; +use vars qw ( $cgi $agent $action $hashref $p $agent_type ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(header menubar popurl); +use FS::Record qw(qsearch qsearchs fields); use FS::agent; -use FS::CGI qw(header menubar); +use FS::agent_type; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($agent,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $agent=qsearchs('agent',{'agentnum'=>$1}); - $action='Edit'; +if ( $cgi->param('error') ) { + $agent = new FS::agent ( { + map { $_, scalar($cgi->param($_)) } fields('agent') + } ); +} elsif ( $cgi->keywords ) { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $agent = qsearchs( 'agent', { 'agentnum' => $1 } ); } else { #adding - $agent=create FS::agent {}; - $action='Add'; + $agent = new FS::agent {}; } -my($hashref)=$agent->hashref; +$action = $agent->agentnum ? 'Edit' : 'Add'; +$hashref = $agent->hashref; + +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("$action Agent", menubar( + 'Main Menu' => $p, + 'View all agents' => $p. 'browse/agent.cgi', +)); -print header("$action Agent", menubar( - 'Main Menu' => '../', - 'View all agents' => '../browse/agent.cgi', -)), '<FORM ACTION="process/agent.cgi" METHOD=POST>'; +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!, +print '<FORM ACTION="', popurl(1), 'process/agent.cgi" METHOD=POST>', + qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!, "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)"; print <<END; @@ -49,11 +81,10 @@ Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashre Agent type <SELECT NAME="typenum" SIZE=1> END -my($agent_type); foreach $agent_type (qsearch('agent_type',{})) { - print "<OPTION"; + print "<OPTION VALUE=". $agent_type->typenum; print " SELECTED" - if $hashref->{typenum} == $agent_type->getfield('typenum'); + if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum ); print ">", $agent_type->getfield('typenum'), ": ", $agent_type->getfield('atype'),"\n"; } diff --git a/htdocs/edit/agent_type.cgi b/htdocs/edit/agent_type.cgi index b9fff4530..bdf64c58f 100755 --- a/htdocs/edit/agent_type.cgi +++ b/htdocs/edit/agent_type.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: agent_type.cgi,v 1.11 1999-04-07 11:19:21 ivan Exp $ +# # agent_type.cgi: Add/Edit agent type (output form) # # ivan@sisd.com 97-dec-10 @@ -9,46 +11,91 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: agent_type.cgi,v $ +# Revision 1.11 1999-04-07 11:19:21 ivan +# silly HTML typo +# +# Revision 1.10 1999/01/25 12:09:51 ivan +# yet more mod_perl stuff +# +# Revision 1.9 1999/01/19 05:13:32 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.8 1999/01/18 09:41:22 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.7 1999/01/18 09:22:29 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.6 1998/12/17 06:16:58 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.5 1998/11/21 07:58:27 ivan +# package names link to them +# +# Revision 1.4 1998/11/21 07:45:19 ivan +# visual, use FS::table_name when doing qsearch('table_name') +# +# Revision 1.3 1998/11/15 11:20:12 ivan +# s/CGI-Base/CGI.pm/ causes s/QUERY_STRING/keywords/; +# +# Revision 1.2 1998/11/13 09:56:46 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base; +use vars qw( $cgi $agent_type $action $hashref $p $part_pkg ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::agent_type; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); +use FS::agent_type; +use FS::part_pkg; +use FS::type_pkgs; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($agent_type,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $agent_type = new FS::agent_type ( { + map { $_, scalar($cgi->param($_)) } fields('agent') + } ); +} elsif ( $cgi->keywords ) { #editing + my( $query ) = $cgi->keywords; + $query =~ /^(\d+)$/; $agent_type=qsearchs('agent_type',{'typenum'=>$1}); - $action='Edit'; } else { #adding - $agent_type=create FS::agent_type {}; - $action='Add'; + $agent_type = new FS::agent_type {}; } -my($hashref)=$agent_type->hashref; +$action = $agent_type->typenum ? 'Edit' : 'Add'; +$hashref = $agent_type->hashref; + +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Agent Type", menubar( + 'Main Menu' => "$p", + 'View all agent types' => "${p}browse/agent_type.cgi", +)); -print header("$action Agent Type", menubar( - 'Main Menu' => '../', - 'View all agent types' => '../browse/agent_type.cgi', -)), '<FORM ACTION="process/agent_type.cgi" METHOD=POST>'; +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!, +print '<FORM ACTION="', popurl(1), 'process/agent_type.cgi" METHOD=POST>', + qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!, "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)"; print <<END; -<BR>Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}"> -<P>Select which packages agents of this type may sell to customers</P> +<BR><BR>Agent Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}"> +<BR><BR>Select which packages agents of this type may sell to customers<BR> END -my($part_pkg); foreach $part_pkg ( qsearch('part_pkg',{}) ) { print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!, $part_pkg->getfield('pkgpart'), qq!" !, @@ -59,7 +106,9 @@ foreach $part_pkg ( qsearch('part_pkg',{}) ) { }) ? 'CHECKED ' : '', - qq!"VALUE="ON"> !,$part_pkg->getfield('pkg') + qq!VALUE="ON"> !, + qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart, + '">', $part_pkg->getfield('pkg'), '</A>', ; } diff --git a/htdocs/edit/cust_credit.cgi b/htdocs/edit/cust_credit.cgi index 75ef21208..35c4d48fe 100755 --- a/htdocs/edit/cust_credit.cgi +++ b/htdocs/edit/cust_credit.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_credit.cgi: Add a credit (output form) +# $Id: cust_credit.cgi,v 1.7 1999-02-28 00:03:33 ivan Exp $ # # Usage: cust_credit.cgi custnum [ -paybatch ] # http://server.name/path/cust_credit?custnum [ -paybatch ] # -# Note: Should be run setuid root as user nobody. -# # some hooks in here for modifications as well as additions, but needs (lots) more work. # also see process/cust_credit.cgi, the script that processes the form. # @@ -23,63 +21,89 @@ # ivan@voicenet.com 97-apr-21 # # rewrite ivan@sisd.com 98-mar-16 +# +# $Log: cust_credit.cgi,v $ +# Revision 1.7 1999-02-28 00:03:33 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:09:52 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:33 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:23 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/23 02:26:06 ivan +# *** empty log message *** +# +# Revision 1.2 1998/12/17 06:16:59 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; +use vars qw( $cgi $query $custnum $otaker $p1 $crednum $_date $amount $reason ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); #CGI module +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw(header popurl); +use FS::Record qw(fields); +#use FS::cust_credit; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint custnum -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; - -#untaint otaker -my($otaker)=getotaker; - -SendHeaders(); # one guess. +if ( $cgi->param('error') ) { + #$cust_credit = new FS::cust_credit ( { + # map { $_, scalar($cgi->param($_)) } fields('cust_credit') + #} ); + $custnum = $cgi->param('custnum'); + $amount = $cgi->param('amount'); + #$refund = $cgi->param('refund'); + $reason = $cgi->param('reason'); +} else { + ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + $amount = ''; + #$refund = 'yes'; + $reason = ''; +} +$_date = time; + +$otaker = getotaker; + +$p1 = popurl(1); + +print $cgi->header( '-expires' => 'now' ), header("Post Credit", ''); +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); print <<END; -<HTML> - <HEAD> - <TITLE>Post Credit</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Post Credit</H1> - </CENTER> - <FORM ACTION="process/cust_credit.cgi" METHOD=POST> - <HR><PRE> + <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST> + <PRE> END -#crednum -my($crednum)=""; +$crednum = ""; print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!; -#custnum print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; -#paybatch print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!; -#date -my($date)=time; -print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!; +print qq!\nDate: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="">!; -#amount -my($amount)=''; print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!; +print qq!<INPUT TYPE="hidden" NAME="credited" VALUE="">!; -#refund? -#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">Also post refund!; +#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!; -#otaker (hidden) print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!; -#reason -my($reason)=''; print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!; print <<END; diff --git a/htdocs/edit/cust_main.cgi b/htdocs/edit/cust_main.cgi index 14556010c..813c4b54f 100755 --- a/htdocs/edit/cust_main.cgi +++ b/htdocs/edit/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_main.cgi: Edit a customer (output form) +# $Id: cust_main.cgi,v 1.14 1999-04-14 07:47:53 ivan Exp $ # # Usage: cust_main.cgi custnum # http://server.name/path/cust_main.cgi?custnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-nov-29 -> 96-dec-04 # # Blank custnum for new customer. @@ -38,82 +36,180 @@ # bmccane@maxbaud.net 98-apr-3 # # fixed one missed day->daytime ivan@sisd.com 98-jul-13 +# +# $Log: cust_main.cgi,v $ +# Revision 1.14 1999-04-14 07:47:53 ivan +# i18n fixes +# +# Revision 1.13 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.12 1999/04/06 11:16:16 ivan +# give a meaningful error message if you try to create a customer before you've +# created an agent +# +# Revision 1.11 1999/03/25 13:55:10 ivan +# one-screen new customer entry (including package and service) for simple +# packages with one svc_acct service +# +# Revision 1.10 1999/02/28 00:03:34 ivan +# removed misleading comments +# +# Revision 1.9 1999/02/23 08:09:20 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.8 1999/01/25 12:09:53 ivan +# yet more mod_perl stuff +# +# Revision 1.7 1999/01/19 05:13:34 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:24 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1999/01/18 09:22:30 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.4 1998/12/23 08:08:15 ivan +# fix typo +# +# Revision 1.3 1998/12/17 06:17:00 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base; +use vars qw( $cgi $custnum $action $cust_main $p1 @agents $agentnum + $last $first $ss $company $address1 $address2 $city $zip + $daytime $night $fax @invoicing_list $invoicing_list $payinfo + $payname %payby %paybychecked $refnum $otaker $r ); +use vars qw ( $conf $pkgpart $username $password $popnum $ulen $ulen2 ); +use CGI::Switch; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); +#use FS::Record qw(qsearch qsearchs fields); +use FS::Record qw(qsearch qsearchs fields dbdef); +use FS::CGI qw(header popurl itable table); use FS::cust_main; +use FS::agent; +use FS::part_referral; +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; + #for misplaced logic below + use FS::pkg_svc; + use FS::part_svc; + use FS::part_pkg; -cgisuidsetup($cgi); + #for false laziness below + use FS::svc_acct_pop; -SendHeaders(); # one guess. + #for (other) false laziness below + use FS::agent; + use FS::type_pkgs; + +$cgi = new CGI; +cgisuidsetup($cgi); #get record -my($custnum,$action,$cust_main); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing + +if ( $cgi->param('error') ) { + $cust_main = new FS::cust_main ( { + map { $_, scalar($cgi->param($_)) } fields('cust_main') + } ); + $custnum = $cust_main->custnum; + $pkgpart = $cgi->param('pkgpart_svcpart') || ''; + if ( $pkgpart =~ /^(\d+)_/ ) { + $pkgpart = $1; + } else { + $pkgpart = ''; + } + $username = $cgi->param('username'); + $password = $cgi->param('_password'); + $popnum = $cgi->param('popnum'); +} elsif ( $cgi->keywords ) { #editing + my( $query ) = $cgi->keywords; + $query =~ /^(\d+)$/; $custnum=$1; - $cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); - $action='Edit'; + $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); + $pkgpart = 0; + $username = ''; + $password = ''; + $popnum = 0; } else { $custnum=''; - $cust_main = create FS::cust_main ( {} ); + $cust_main = new FS::cust_main ( {} ); $cust_main->setfield('otaker',&getotaker); - $cust_main->setfield('country','US'); - $action='Add'; + $pkgpart = 0; + $username = ''; + $password = ''; + $popnum = 0; } - -print <<END; -<HTML> - <HEAD> - <TITLE>Customer $action</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Customer $action</H1> - </CENTER> - <FORM ACTION="process/cust_main.cgi" METHOD=POST> - <PRE> -END - -print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!, - qq!Customer #<FONT SIZE="+1"><B>!; -print $custnum ? $custnum : " (NEW)" , "</B></FONT>"; - -#agentnum -my($agentnum)=$cust_main->agentnum || 1; #set to first agent by default -my(@agents) = qsearch('agent',{}); -print qq!\n\nAgent # <SELECT NAME="agentnum" SIZE="1">!; -my($agent); -foreach $agent (sort { - $a->agent cmp $b->agent; -} @agents) { - print "<OPTION" . " SELECTED"x($agent->agentnum==$agentnum), - ">", $agent->agentnum,": ", $agent->agent, "\n"; +$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>!, + 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; +$agentnum = $cust_main->agentnum || $agents[0]->agentnum; #default to first +if ( scalar(@agents) == 1 ) { + print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$agentnum">!; +} else { + print qq!<BR><BR>${r}Agent <SELECT NAME="agentnum" SIZE="1">!; + my $agent; + foreach $agent (sort { + $a->agent cmp $b->agent; + } @agents) { + print '<OPTION VALUE="', $agent->agentnum, '"', + " SELECTED"x($agent->agentnum==$agentnum), + ">", $agent->agentnum,": ", $agent->agent; + } + print "</SELECT>"; } -print "</SELECT>"; #referral -#unless ($custnum) { - my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error + +$refnum = $cust_main->refnum || 0; +if ( $custnum ) { + print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!; +} else { my(@referrals) = qsearch('part_referral',{}); - print qq!\nReferral <SELECT NAME="refnum" SIZE="1">!; - print "<OPTION> \n"; - my($referral); - foreach $referral (sort { - $a->refnum <=> $b->refnum; - } @referrals) { - print "<OPTION" . " SELECTED"x($referral->refnum==$refnum), - ">", $referral->refnum, ": ", $referral->referral,"\n"; + if ( scalar(@referrals) == 1 ) { + $refnum ||= $referrals[0]->refnum; + print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!; + } else { + print qq!<BR><BR>${r}Referral <SELECT NAME="refnum" SIZE="1">!; + print "<OPTION> "; + my($referral); + foreach $referral (sort { + $a->refnum <=> $b->refnum; + } @referrals) { + print "<OPTION" . " SELECTED"x($referral->refnum==$refnum), + ">", $referral->refnum, ": ", $referral->referral; + } + print "</SELECT>"; } - print "</SELECT>"; -#} +} -my($last,$first,$ss,$company,$address1,$address2,$city)=( + +# contact info + +($last,$first,$ss,$company,$address1,$address2,$city,$zip)=( $cust_main->last, $cust_main->first, $cust_main->ss, @@ -121,94 +217,217 @@ my($last,$first,$ss,$company,$address1,$address2,$city)=( $cust_main->address1, $cust_main->address2, $cust_main->city, + $cust_main->zip, ); -print <<END; - - -Name (last)<INPUT TYPE="text" NAME="last" VALUE="$last"> (first)<INPUT TYPE="text" NAME="first" VALUE="$first"> SS# <INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11 MAXLENGTH=11> -Company <INPUT TYPE="text" NAME="company" VALUE="$company"> -Address <INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=40 MAXLENGTH=40> - <INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=40 MAXLENGTH=40> -City <INPUT TYPE="text" NAME="city" VALUE="$city"> State (county) <SELECT NAME="state" SIZE="1"> +print "<BR><BR>Contact information", &itable("#c0c0c0"), <<END; +<TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3><INPUT TYPE="text" NAME="last" VALUE="$last">, <INPUT TYPE="text" NAME="first" VALUE="$first"></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"><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1"> END +$cust_main->country('US') unless $cust_main->country; #eww foreach ( qsearch('cust_main_county',{}) ) { print "<OPTION"; print " SELECTED" if ( $cust_main->state eq $_->state - && $cust_main->county eq $_->county ); + && $cust_main->county eq $_->county + && $cust_main->country eq $_->country + ); print ">",$_->state; print " (",$_->county,")" if $_->county; + print " / ", $_->country; } -print "</SELECT>"; +print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!; -my($zip,$country,$daytime,$night,$fax)=( - $cust_main->zip, - $cust_main->country, +($daytime,$night,$fax)=( $cust_main->daytime, $cust_main->night, $cust_main->fax, ); print <<END; - Zip <INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10 MAXLENGTH=10> -Country: <FONT SIZE="+1"><B>$country</B></FONT><INPUT TYPE="hidden" NAME="country" VALUE="$country"> +<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18></TD></TR> +<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18></TD></TR> +<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12></TD></TR> +END -Phone (daytime)<INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18 MAXLENGTH=20> (night)<INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18 MAXLENGTH=20> (fax)<INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12 MAXLENGTH=12> +print "</TABLE>$r required fields<BR>"; -END +# billing info -my(%payby)=( - 'CARD' => "Credit card ", - 'BILL' => "Billing ", - 'COMP' => "Complimentary", -); -for (qw(CARD BILL COMP)) { - print qq!<INPUT TYPE="radio" NAME="payby" VALUE="$_"!; - print qq! CHECKED! if ($cust_main->payby eq "$_"); - print qq!>$payby{$_}!; -} +sub expselect { + my $prefix = shift; + my $date = shift || ''; + my( $m, $y ) = ( 0, 0 ); + if ( $date =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #PostgreSQL date format + ( $m, $y ) = ( $2, $1 ); + } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $m, $y ) = ( $1, $3 ); + } + 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 ( 1999 .. 2037 ) { + $return .= "<OPTION"; + $return .= " SELECTED" if $_ == $y; + $return .= ">$_"; + } + $return .= "</SELECT>"; + $return; +} -my($payinfo,$payname,$otaker)=( +print "<BR>Billing information", &itable("#c0c0c0"), + qq!<TR><TD><INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!; +print qq! CHECKED! if $cust_main->tax eq "Y"; +print qq!>Tax Exempt</TD></TR>!; +print qq!<TR><TD><INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"!; +@invoicing_list = $cust_main->invoicing_list; +print qq! CHECKED! + if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list; +print qq!>Postal mail invoice</TD></TR>!; +$invoicing_list = join(', ', grep { $_ ne 'POST' } @invoicing_list ); +print qq!<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="$invoicing_list"></TD></TR>!; + +print "<TR><TD>Billing type</TD></TR>", + "</TABLE>", + &table("#c0c0c0"), "<TR>"; + +($payinfo, $payname)=( $cust_main->payinfo, $cust_main->payname, - $cust_main->otaker, ); -my($paydate); -if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { - $paydate="$2/$1" -} elsif ( $cust_main->paydate =~ /^(\d{2})-\d{2}-(\d{4}$)/ ) { - $paydate="$1/$2" -} -else { - $paydate=''; +%payby = ( + 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!, + 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR>${r}Exp !. expselect("BILL", "12-2037"). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!, + 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"), +); +%paybychecked = ( + 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!, + 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("BILL", $cust_main->paydate). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!, + 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate), +); +for (qw(CARD BILL COMP)) { + print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!; + if ($cust_main->payby eq "$_") { + print qq! CHECKED> $paybychecked{$_}</TD>!; + } else { + print qq!> $payby{$_}</TD>!; + } } -print <<END; - - Card number , P.O. # or Authorization <INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo" SIZE=19 MAXLENGTH=19> -END - -print qq!Exp. date (MM/YY or MM/YYYY)<INPUT TYPE="text" NAME="paydate" VALUE="$paydate" SIZE=8 MAXLENGTH=7> Billing name <INPUT TYPE="text" NAME="payname" VALUE="$payname">\n<INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!; -print qq! CHECKED! if $cust_main->tax eq "Y"; -print qq!> Tax Exempt!; - -print <<END; +print "</TR></TABLE>$r required fields for each billing type"; + +unless ( $custnum ) { + # pry the wrong place for this logic. also pretty expensive + #use FS::pkg_svc; + #use FS::part_svc; + #use FS::part_pkg; + + #false laziness, copied from FS::cust_pkg::order + my %part_pkg; + if ( scalar(@agents) == 1 ) { + # generate %part_pkg + # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart + #my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); + #my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); + my($agent)=qsearchs('agent',{'agentnum'=> $agentnum }); + + my($type_pkgs); + foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + my($pkgpart)=$type_pkgs->pkgpart; + $part_pkg{$pkgpart}++; + } + } else { + #can't know (agent not chosen), so, allow all + my %typenum; + foreach my $agent ( @agents ) { + next if $typenum{$agent->typenum}++; + foreach my $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + my($pkgpart)=$type_pkgs->pkgpart; + $part_pkg{$pkgpart}++; + } + } + } + #eslaf + + my %pkgpart; + #foreach ( @pkg_svc ) { + foreach ( qsearch( 'pkg_svc', {} ) ) { + my $part_svc = qsearchs ( 'part_svc', { 'svcpart' => $_->svcpart } ); + $pkgpart{ $_->pkgpart } = -1 # never will == 1 below + if ( $part_svc->svcdb ne 'svc_acct' ); + if ( $pkgpart{ $_->pkgpart } ) { + $pkgpart{ $_->pkgpart } = '-1'; + } else { + $pkgpart{ $_->pkgpart } = $_->svcpart; + } + } -Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker"> -</PRE> + my @part_pkg = + #grep { $pkgpart{ $_->pkgpart } == 1 } qsearch( 'part_pkg', {} ); + grep { + #( $pkgpart{ $_->pkgpart } || 0 ) == 1 + $pkgpart{ $_->pkgpart } + && $pkgpart{ $_->pkgpart } != -1 + && $part_pkg{ $_->pkgpart } + ; + } qsearch( 'part_pkg', {} ); + + if ( @part_pkg ) { + + print "<BR><BR>First package", &itable("#c0c0c0"), + qq!<TR><TD COLSPAN=2><SELECT NAME="pkgpart_svcpart">!; + + print qq!<OPTION VALUE="">(none)!; + + foreach my $part_pkg ( @part_pkg ) { + print qq!<OPTION VALUE="!, + $part_pkg->pkgpart. "_". $pkgpart{ $part_pkg->pkgpart }, '"'; + print " SELECTED" if $pkgpart && ( $part_pkg->pkgpart == $pkgpart ); + print ">", $part_pkg->pkg, " - ", $part_pkg->comment; + } + print "</SELECT></TD></TR>"; + + #false laziness: (mostly) copied from edit/svc_acct.cgi + #$ulen = $svc_acct->dbdef_table->column('username')->length; + $ulen = dbdef->table('svc_acct')->column('username')->length; + $ulen2 = $ulen+2; + print <<END; +<TR><TD ALIGN="right">Username</TD> +<TD><INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen></TD></TR> +<TR><TD ALIGN="right">Password</TD> +<TD><INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8> +(blank to generate)</TD></TR> END + print qq!<TR><TD ALIGN="right">POP</TD><TD><SELECT NAME="popnum" SIZE=1><OPTION> !; + my($svc_acct_pop); + foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) { + print qq!<OPTION VALUE="!, $svc_acct_pop->popnum, '"', + ( $popnum && $svc_acct_pop->popnum == $popnum ) ? ' SELECTED' : '', ">", + $svc_acct_pop->popnum, ": ", + $svc_acct_pop->city, ", ", + $svc_acct_pop->state, + " (", $svc_acct_pop->ac, ")/", + $svc_acct_pop->exch, "\n" + ; + } + print "</SELECT></TD></TR></TABLE>"; + } +} -print qq!<CENTER><INPUT TYPE="submit" VALUE="!, - $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!; - -print <<END; - - </FORM> - </BODY> -</HTML> -END +$otaker = $cust_main->otaker; +print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!, + qq!<BR><BR><INPUT TYPE="submit" VALUE="!, + $custnum ? "Apply Changes" : "Add Customer", qq!">!, + "</FORM></BODY></HTML>", +; diff --git a/htdocs/edit/cust_main_county-expand.cgi b/htdocs/edit/cust_main_county-expand.cgi index 59ff7043a..783e92826 100755 --- a/htdocs/edit/cust_main_county-expand.cgi +++ b/htdocs/edit/cust_main_county-expand.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county-expand.cgi: Expand a state into counties (output form) +# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -8,39 +8,78 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county-expand.cgi,v $ +# Revision 1.6 1999-01-25 12:09:54 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:35 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:25 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:17:01 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/18 09:01:38 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $taxnum $cust_main_county $p1 $delim $expansion ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -$cgi->var('QUERY_STRING') =~ /^(\d+)$/ - or die "Illegal taxnum!"; -my($taxnum)=$1; +if ( $cgi->param('error') ) { + $taxnum = $cgi->param('taxnum'); + $delim = $cgi->param('delim'); + $expansion = $cgi->param('expansion'); +} else { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/ + or die "Illegal taxnum!"; + $taxnum = $1; + $delim = 'n'; + $expansion = ''; +} -my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}); +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}); die "Can't expand entry!" if $cust_main_county->getfield('county'); -print header("Tax Rate (expand state)", menubar( - 'Main Menu' => '../', -)), <<END; - <FORM ACTION="process/cust_main_county-expand.cgi" METHOD=POST> +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Tax Rate (expand)", menubar( + 'Main Menu' => popurl(2), +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print <<END; + <FORM ACTION="${p1}process/cust_main_county-expand.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum"> - Separate counties by - <INPUT TYPE="radio" NAME="delim" VALUE="n" CHECKED>line - (rumor has it broken on some browsers) or - <INPUT TYPE="radio" NAME="delim" VALUE="s">whitespace. + Separate by +END +print '<INPUT TYPE="radio" NAME="delim" VALUE="n"'; +print ' CHECKED' if $delim eq 'n'; +print '>line (rumor has it broken on some browsers) or', + '<INPUT TYPE="radio" NAME="delim" VALUE="s"'; +print ' CHECKED' if $delim eq 's'; +print '>whitespace.'; +print <<END; <BR><INPUT TYPE="submit" VALUE="Submit"> - <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA> + <BR><TEXTAREA NAME="expansion" ROWS=100>$expansion</TEXTAREA> </FORM> </CENTER> </BODY> diff --git a/htdocs/edit/cust_main_county.cgi b/htdocs/edit/cust_main_county.cgi index 904d58346..747a63df6 100755 --- a/htdocs/edit/cust_main_county.cgi +++ b/htdocs/edit/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county.cgi: Edit tax rates (output form) +# $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-13-16 # @@ -9,41 +9,75 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.8 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.7 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.6 1999/01/25 12:09:55 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:36 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:26 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:17:02 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/18 09:01:39 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $cust_main_county ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +print $cgi->header( '-expires' => 'now' ), header("Edit tax rates", menubar( + 'Main Menu' => popurl(2), +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print header("Edit tax rates", menubar( - 'Main Menu' => '../', -)),<<END; - <FORM ACTION="process/cust_main_county.cgi" METHOD=POST> - <TABLE BORDER> +print qq!<FORM ACTION="!, popurl(1), + qq!process/cust_main_county.cgi" METHOD=POST>!, &table(), <<END; <TR> + <TH><FONT SIZE=-1>Country</FONT></TH> <TH><FONT SIZE=-1>State</FONT></TH> <TH>County</TH> <TH><FONT SIZE=-1>Tax</FONT></TH> </TR> END -my($cust_main_county); foreach $cust_main_county ( qsearch('cust_main_county',{}) ) { my($hashref)=$cust_main_county->hashref; print <<END; <TR> - <TD>$hashref->{state}</TD> + <TD>$hashref->{country}</TD> END + print "<TD>", $hashref->{state} + ? $hashref->{state} + : '(ALL)' + , "</TD>"; + print "<TD>", $hashref->{county} ? $hashref->{county} : '(ALL)' diff --git a/htdocs/edit/cust_pay.cgi b/htdocs/edit/cust_pay.cgi index a6cb204d1..5dee76ed9 100755 --- a/htdocs/edit/cust_pay.cgi +++ b/htdocs/edit/cust_pay.cgi @@ -1,61 +1,82 @@ #!/usr/bin/perl -Tw # -# cust_pay.cgi: Add a payment (output form) +# $Id: cust_pay.cgi,v 1.6 1999-02-28 00:03:35 ivan Exp $ # # Usage: cust_pay.cgi invnum # http://server.name/path/cust_pay.cgi?invnum # -# Note: Should be run setuid as user nobody. -# # some hooks for modifications as well as additions, but needs work. # # ivan@voicenet.com 96-dec-11 # # rewrite ivan@sisd.com 98-mar-16 +# +# $Log: cust_pay.cgi,v $ +# Revision 1.6 1999-02-28 00:03:35 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/25 12:09:56 ivan +# yet more mod_perl stuff +# +# Revision 1.4 1999/01/19 05:13:37 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 09:41:27 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:03 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; +use vars qw( $cgi $invnum $p1 $_date $payby $payinfo $paid ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint invnum -$QUERY_STRING =~ /^(\d+)$/; -my($invnum)=$1; +if ( $cgi->param('error') ) { + $invnum = $cgi->param('invnum'); + $paid = $cgi->param('paid'); + $payby = $cgi->param('payby'); + $payinfo = $cgi->param('payinfo'); +} else { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $invnum = $1; + $paid = ''; + $payby = "BILL"; + $payinfo = ""; +} +$_date = time; + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Enter payment", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -SendHeaders(); # one guess. print <<END; -<HTML> - <HEAD> - <TITLE>Enter payment</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Enter payment</H1> - </CENTER> - <FORM ACTION="process/cust_pay.cgi" METHOD=POST> + <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST> <HR><PRE> END -#invnum print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!; -#date -my($date)=time; -print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!; +print qq!<BR>Date: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!; -#paid -print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" SIZE=8 MAXLENGTH=8>!; +print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8>!; -#payby -my($payby)="BILL"; print qq!<BR>Payby: <B>$payby</B><INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!; #payinfo (check # now as payby="BILL" hardcoded.. what to do later?) -my($payinfo)=""; print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!; #paybatch @@ -64,7 +85,7 @@ print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!; print <<END; </PRE> <BR> -<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER> +<INPUT TYPE="submit" VALUE="Post payment"> END print <<END; diff --git a/htdocs/edit/cust_pkg.cgi b/htdocs/edit/cust_pkg.cgi index d7f143db4..766aa60ac 100755 --- a/htdocs/edit/cust_pkg.cgi +++ b/htdocs/edit/cust_pkg.cgi @@ -1,14 +1,12 @@ #!/usr/bin/perl -Tw # -# cust_pkg.cgi: Add/edit packages (output form) +# $Id: cust_pkg.cgi,v 1.7 1999-04-14 01:03:01 ivan Exp $ # # this is for changing packages around, not editing things within the package # # Usage: cust_pkg.cgi custnum # http://server.name/path/cust_pkg.cgi?custnum # -# Note: Should be run setuid freeside as user nobody -# # started with /sales/add/cust_pkg.cgi, which added packages # ivan@voicenet.com 97-jan-5, 97-mar-21 # @@ -23,66 +21,89 @@ # # 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.7 1999-04-14 01:03:01 ivan +# oops, in 1.2 tree, can't do searches until [cgi|admin]suidsetup, +# bug is hidden by mod_perl persistance +# +# Revision 1.6 1999/02/28 00:03:36 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:18 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:38 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 09:41:28 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:04 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg + $cust_main $agent $type_pkgs $count %remove_pkg ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup getotaker); +use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(header popurl); +use FS::part_pkg; +use FS::type_pkgs; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -my(%pkg,%comment); +%pkg = (); +%comment = (); foreach (qsearch('part_pkg', {})) { $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg'); $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment'); } -#untaint custnum -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; +if ( $cgi->param('error') ) { + $custnum = $cgi->param('custnum'); + %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg'); +} else { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + undef %remove_pkg; +} -my($otaker)=&getotaker; +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''); -SendHeaders(); -print <<END; -<HTML> - <HEAD> - <TITLE>Add/Edit Packages</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Add/Edit Packages</H1> - </CENTER> - <FORM ACTION="process/cust_pkg.cgi" METHOD=POST> - <HR> -END +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -#custnum -print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!; +print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!; -#current packages (except cancelled packages) -my(@cust_pkg) = grep ! $_->getfield('cancel'), - qsearch('cust_pkg',{'custnum'=>$custnum}); +print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!; + +#current packages +@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } ); if (@cust_pkg) { print <<END; -<CENTER><FONT SIZE="+2">Current packages</FONT></CENTER> -These are packages the customer currently has. Select those packages you -wish to remove (if any).<BR><BR> +Current packages - select to remove (services are moved to a new package below) +<BR><BR> END my ($count) = 0 ; - print qq!<CENTER><TABLE>! ; + print qq!<TABLE>! ; foreach (@cust_pkg) { - print qq!<TR>! if ($count ==0) ; + print '<TR>' if $count == 0; my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') ); - print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum">!, - #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!, - #now you've got to admit this bug was pretty cool - qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!; + print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!; + print " CHECKED" if $remove_pkg{$pkgnum}; + print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!; $count ++ ; if ($count == 2) { @@ -90,29 +111,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 -my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); -my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); +$agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); -my($type_pkgs); -my ($count) = 0 ; -print qq!<CENTER><TABLE>! ; +$count = 0 ; +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 ++ ; @@ -122,13 +139,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 9fe739bb7..f7ade88c8 100755 --- a/htdocs/edit/part_pkg.cgi +++ b/htdocs/edit/part_pkg.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $ +# # part_pkg.cgi: Add/Edit package (output form) # # ivan@sisd.com 97-dec-10 @@ -9,37 +11,99 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: part_pkg.cgi,v $ +# Revision 1.9 1999-02-07 09:59:19 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.8 1999/01/19 05:13:39 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.7 1999/01/18 09:41:29 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.6 1998/12/17 06:17:05 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.5 1998/11/21 07:12:26 ivan +# *** empty log message *** +# +# Revision 1.4 1998/11/21 07:11:08 ivan +# *** empty log message *** +# +# Revision 1.3 1998/11/21 07:07:40 ivan +# popurl, bugfix +# +# Revision 1.2 1998/11/15 13:14:55 ivan +# first pass as per-user custom pricing +# use strict; -use CGI::Base; +use vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::part_pkg; +use FS::part_svc; use FS::pkg_svc; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +if ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) { + $cgi->param('clone', $1); +} else { + $cgi->param('clone', ''); +} +if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + $cgi->param('pkgnum', $1); +} else { + $cgi->param('pkgnum', ''); +} -my($part_pkg,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1}); - $action='Edit'; -} else { #adding - $part_pkg=create FS::part_pkg {}; - $action='Add'; +($query) = $cgi->keywords; +$action = ''; +$part_pkg = ''; +if ( $cgi->param('error') ) { + $part_pkg = new FS::part_pkg ( { + map { $_, scalar($cgi->param($_)) } fields('part_pkg') + } ); } -my($hashref)=$part_pkg->hashref; +if ( $cgi->param('clone') ) { + $action='Custom Pricing'; + my $old_part_pkg = + qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } ); + $part_pkg ||= $old_part_pkg->clone; +} elsif ( $query && $query =~ /^(\d+)$/ ) { + $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1}); +} else { + $part_pkg ||= new FS::part_pkg {}; +} +$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add'; +$hashref = $part_pkg->hashref; + +print $cgi->header( '-expires' => 'now' ), header("$action Package Definition", menubar( + 'Main Menu' => popurl(2), + 'View all packages' => popurl(2). 'browse/part_pkg.cgi', +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -print header("$action Package Definition", menubar( - 'Main Menu' => '../', - 'View all packages' => '../browse/part_pkg.cgi', -)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>'; +print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; + +if ( $cgi->param('clone') ) { + print qq!<INPUT TYPE="hidden" NAME="clone" VALUE="!, $cgi->param('clone'), qq!">!; +} +if ( $cgi->param('pkgnum') ) { + print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="!, $cgi->param('pkgnum'), qq!">!; +} print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!, "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)"; @@ -54,41 +118,51 @@ Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashr </PRE> +END + +unless ( $cgi->param('clone') ) { + print <<END; Enter the quantity of each service this package includes.<BR><BR> <TABLE BORDER><TR><TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH> <TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH></TR> END +} -my($part_svc); -my($count) = 0 ; -foreach $part_svc ( qsearch('part_svc',{}) ) { - - my($svcpart)=$part_svc->getfield('svcpart'); - my($pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $part_pkg->getfield('pkgpart'), +$count = 0; +foreach $part_svc ( ( qsearch( 'part_svc', {} ) ) ) { + my $svcpart = $part_svc->svcpart; + my $pkg_svc = qsearchs( 'pkg_svc', { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, 'svcpart' => $svcpart, - }) || create FS::pkg_svc({ - 'pkgpart' => $part_pkg->getfield('pkgpart'), + } ) || new FS::pkg_svc ( { + 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart, 'svcpart' => $svcpart, 'quantity' => 0, }); - next unless $pkg_svc; - - print qq!<TR>! if $count == 0 ; - print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!, - $pkg_svc->getfield('quantity') || 0,qq!"></TD>!, - qq!<TD><A HREF="part_svc.cgi?!,$part_svc->getfield('svcpart'), - qq!">!, $part_svc->getfield('svc'), "</A></TD>"; - $count ++ ; - if ($count == 2) - { - print qq!</TR>! ; - $count = 0 ; + #? #next unless $pkg_svc; + + unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) { + print '<TR>' if $count == 0 ; + print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!, + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, + qq!"></TD><TD><A HREF="part_svc.cgi?!,$part_svc->svcpart, + qq!">!, $part_svc->getfield('svc'), "</A></TD>"; + $count++; + if ($count == 2) + { + print '</TR>'; + $count = 0; + } + } else { + print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!, + $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!; } } -print qq!</TR>! if ($count != 0) ; -print "</TABLE>"; +unless ( $cgi->param('clone') ) { + print qq!</TR>! if ($count != 0) ; + print "</TABLE>"; +} print qq!<BR><INPUT TYPE="submit" VALUE="!, $hashref->{pkgpart} ? "Apply changes" : "Add package", diff --git a/htdocs/edit/part_referral.cgi b/htdocs/edit/part_referral.cgi index f29802239..24ac9dd82 100755 --- a/htdocs/edit/part_referral.cgi +++ b/htdocs/edit/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: Add/Edit referral (output form) +# $Id: part_referral.cgi,v 1.6 1999-04-07 11:43:23 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -10,40 +10,64 @@ # confisuing typo on submit button ivan@sisd.com 98-jun-14 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# Revision 1.6 1999-04-07 11:43:23 ivan +# pick up errors right away, leave input +# +# Revision 1.5 1999/02/07 09:59:20 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:41 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 09:41:30 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:06 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base; +use vars qw( $cgi $part_referral $action $hashref $p1 $query ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::part_referral; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($part_referral,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $part_referral=qsearchs('part_referral',{'refnum'=>$1}); - $action='Edit'; +if ( $cgi->param('error') ) { + $part_referral = new FS::part_referral ( { + map { $_, scalar($cgi->param($_)) } fields('part_referral') + } ); +} elsif ( $cgi->keywords ) { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $part_referral = qsearchs( 'part_referral', { 'refnum' => $1 } ); } else { #adding - $part_referral=create FS::part_referral {}; - $action='Add'; + $part_referral = new FS::part_referral {}; } -my($hashref)=$part_referral->hashref; +$action = $part_referral->refnum ? 'Edit' : 'Add'; +$hashref = $part_referral->hashref; -print header("$action Referral", menubar( - 'Main Menu' => '../', - 'View all referrals' => "../browse/part_referral.cgi", -)), <<END; - <FORM ACTION="process/part_referral.cgi" METHOD=POST> -END +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action Referral", menubar( + 'Main Menu' => popurl(2), + 'View all referrals' => popurl(2). "browse/part_referral.cgi", +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -#display +print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!; print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!, "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)"; diff --git a/htdocs/edit/part_svc.cgi b/htdocs/edit/part_svc.cgi index 491c013fe..e1f1e2ad5 100755 --- a/htdocs/edit/part_svc.cgi +++ b/htdocs/edit/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_svc.cgi: Add/Edit service (output form) +# $Id: part_svc.cgi,v 1.12 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -8,38 +8,80 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: part_svc.cgi,v $ +# Revision 1.12 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.11 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.10 1999/04/08 13:01:50 ivan +# [ AND DOCUMENT! ] all svc_acct services should have a default +# or fixed shell +# +# Revision 1.9 1999/02/23 08:09:21 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.8 1999/02/07 09:59:21 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:42 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:31 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:21 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 06:17:07 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.3 1998/11/21 06:43:26 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $part_svc $action $query $hashref $p %defs $svcdb ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_svc qw(fields); -use FS::CGI qw(header menubar); +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(header menubar popurl table); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($part_svc,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $part_svc = new FS::part_svc ( { + map { $_, scalar($cgi->param($_)) } fields('part_svc') + } ); +} elsif ( $cgi->keywords ) { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; $part_svc=qsearchs('part_svc',{'svcpart'=>$1}); - $action='Edit'; } else { #adding - $part_svc=create FS::part_svc {}; - $action='Add'; + $part_svc = new FS::part_svc {}; } -my($hashref)=$part_svc->hashref; +$action = $part_svc->svcpart ? 'Edit' : 'Add'; +$hashref = $part_svc->hashref; -print header("$action Service Definition", menubar( - 'Main Menu' => '../', - 'View all services' => '../browse/part_svc.cgi', -)), '<FORM ACTION="process/part_svc.cgi" METHOD=POST>'; +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar( + 'Main Menu' => $p, + 'View all services' => "${p}browse/part_svc.cgi", +)); +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); +print '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>'; print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!, "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)"; @@ -47,45 +89,48 @@ print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!, print <<END; <PRE> Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}"> -Table <SELECT NAME="svcdb" SIZE=1> -END - -print map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw( - svc_acct svc_domain svc_acct_sm svc_charge svc_wo -); - -print <<END; -</SELECT></PRE> +</PRE> Services are items you offer to your customers. <UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts <LI>svc_domain - Virtual domains <LI>svc_acct_sm - Virtual domain mail aliasing - <LI>svc_charge - One-time charges (Partially unimplemented) - <LI>svc_wo - Work orders (Partially unimplemented) +END +# <LI>svc_charge - One-time charges (Partially unimplemented) +# <LI>svc_wo - Work orders (Partially unimplemented) +print <<END; </UL> -For the columns in the table selected above, you can set default or fixed +For the selected table, you can give fields default or fixed (unchangable) values. For example, a SLIP/PPP account may have a default (or perhaps fixed) <B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or <B>/usr/bin/passwd</B>. <BR><BR> -<TABLE BORDER CELLPADDING=4><TR><TH>Table</TH><TH>Field</TH> +END +print &table(), '<TR><TH>Table<SELECT NAME="svcdb" SIZE=1>', + map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw( + svc_acct svc_domain svc_acct_sm + ); + print "</SELECT>"; +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo + +print <<END; +</TH><TH>Field</TH> <TH COLSPAN=2>Modifier</TH></TR> END #these might belong somewhere else for other user interfaces #pry need to eventually create stuff that's shared amount UIs -my(%defs)=( +%defs = ( 'svc_acct' => { 'dir' => 'Home directory', 'uid' => 'UID (set to fixed and blank for dial-only)', 'slipip' => 'IP address', - 'popnum' => '<A HREF="../browse/svc_acct_pop.cgi/">POP number</A>', + 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!, 'username' => 'Username', 'quota' => '(unimplemented)', '_password' => 'Password', 'gid' => 'GID (when blank, defaults to UID)', - 'shell' => 'Shell', + 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)', 'finger' => 'GECOS', }, 'svc_domain' => { @@ -105,9 +150,9 @@ my(%defs)=( }, ); -my($svcdb); +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo foreach $svcdb ( qw( - svc_acct svc_domain svc_acct_sm svc_charge svc_wo + svc_acct svc_domain svc_acct_sm ) ) { my(@rows)=map { /^${svcdb}__(.*)$/; $1 } @@ -119,25 +164,28 @@ foreach $svcdb ( qw( my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>"; my($row); foreach $row (@rows) { - my($value)=$part_svc->getfield($svcdb.'__'.$row); - my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag'); - print "<TR>$ptmp<TD>$row - <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT></TD>"; + my $value = $part_svc->getfield($svcdb. '__'. $row); + my $flag = $part_svc->getfield($svcdb. '__'. $row. '_flag'); + print "<TR>$ptmp<TD>$row"; + print "- <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT>" + if defined $defs{$svcdb}{$row}; + print "</TD>"; print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!. - ' CHECKED'x($flag eq ''). "><BR>Off</TD>"; + ' CHECKED'x($flag eq ''). ">Off</TD>"; print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="D"!. ' CHECKED'x($flag eq 'D'). ">Default "; print qq!<INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="F"!. ' CHECKED'x($flag eq 'F'). ">Fixed "; - print qq!<BR><INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!, - "</TD></TR>"; + print qq!<INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!, + "</TD></TR>\n"; $ptmp=''; } } print "</TABLE>"; -print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!, +print qq!\n<BR><INPUT TYPE="submit" VALUE="!, $hashref->{svcpart} ? "Apply changes" : "Add service", - qq!"></CENTER>!; + qq!">!; print <<END; diff --git a/htdocs/edit/process/agent.cgi b/htdocs/edit/process/agent.cgi index 5d1ce3232..c1b397aac 100755 --- a/htdocs/edit/process/agent.cgi +++ b/htdocs/edit/process/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent.cgi: Edit agent (process form) +# $Id: agent.cgi,v 1.7 1999-01-25 12:09:57 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -8,34 +8,51 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent.cgi,v $ +# Revision 1.7 1999-01-25 12:09:57 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:13:47 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:49 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:26 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:16 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/23 07:52:29 ivan +# *** empty log message *** +# use strict; -use CGI::Request; +use vars qw ( $cgi $agentnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::agent qw(fields); -use FS::CGI qw(idiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearch qsearchs fields); +use FS::agent; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; -my($agentnum)=$req->param('agentnum'); +&cgisuidsetup($cgi); -my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; +$agentnum = $cgi->param('agentnum'); -#unmunge typenum -$req->param('typenum') =~ /^(\d+)(:.*)?$/; -$req->param('typenum',$1); +$old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; -my($new)=create FS::agent ( { +$new = new FS::agent ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('agent') } ); -my($error); if ( $agentnum ) { $error=$new->replace($old); } else { @@ -44,10 +61,9 @@ if ( $agentnum ) { } if ( $error ) { - &idiot($error); + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string ); } else { - #$req->cgi->redirect("../../view/agent.cgi?$agentnum"); - #$req->cgi->redirect("../../edit/agent.cgi?$agentnum"); - $req->cgi->redirect("../../browse/agent.cgi"); + print $cgi->redirect(popurl(3). "browse/agent.cgi"); } diff --git a/htdocs/edit/process/agent_type.cgi b/htdocs/edit/process/agent_type.cgi index 43f129fd5..99c54ab3b 100755 --- a/htdocs/edit/process/agent_type.cgi +++ b/htdocs/edit/process/agent_type.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent_type.cgi: Edit agent type (process form) +# $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $ # # ivan@sisd.com 97-dec-11 # @@ -8,29 +8,51 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent_type.cgi,v $ +# Revision 1.7 1999-01-25 12:09:58 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:13:48 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:50 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:27 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:17 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/21 07:49:20 ivan +# s/CGI::Request/CGI.pm/ +# use strict; -use CGI::Request; +use vars qw ( $cgi $typenum $old $new $error $part_pkg ); +use CGI; use CGI::Carp qw(fatalsToBrowser); +use FS::CGI qw( popurl); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::agent_type qw(fields); +use FS::Record qw(qsearch qsearchs fields); +use FS::agent_type; use FS::type_pkgs; -use FS::CGI qw(idiot); +use FS::part_pkg; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($typenum)=$req->param('typenum'); -my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; +$typenum = $cgi->param('typenum'); +$old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; -my($new)=create FS::agent_type ( { +$new = new FS::agent_type ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('agent_type') } ); -my($error); if ( $typenum ) { $error=$new->replace($old); } else { @@ -39,11 +61,11 @@ if ( $typenum ) { } if ( $error ) { - idiot($error); + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string ); exit; } -my($part_pkg); foreach $part_pkg (qsearch('part_pkg',{})) { my($pkgpart)=$part_pkg->getfield('pkgpart'); @@ -51,33 +73,24 @@ foreach $part_pkg (qsearch('part_pkg',{})) { 'typenum' => $typenum, 'pkgpart' => $pkgpart, }); - if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) { + if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) { my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below. - $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs, - #so ->del not ->delete. hmm. hmm. - if ( $error ) { - idiot($error); - exit; - } + $error=$d_type_pkgs->delete; + die $error if $error; - } elsif ( $req->param("pkgpart$pkgpart") + } elsif ( $cgi->param("pkgpart$pkgpart") && ! $type_pkgs ) { #ok to clobber it now (but bad form nonetheless?) - $type_pkgs=create FS::type_pkgs ({ + $type_pkgs=new FS::type_pkgs ({ 'typenum' => $typenum, 'pkgpart' => $pkgpart, }); $error= $type_pkgs->insert; - if ( $error ) { - idiot($error); - exit; - } + die $error if $error; } } -#$req->cgi->redirect("../../view/agent_type.cgi?$typenum"); -#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum"); -$req->cgi->redirect("../../browse/agent_type.cgi"); +print $cgi->redirect(popurl(3). "browse/agent_type.cgi"); diff --git a/htdocs/edit/process/cust_credit.cgi b/htdocs/edit/process/cust_credit.cgi index e660b4c78..ea9c5a3a2 100755 --- a/htdocs/edit/process/cust_credit.cgi +++ b/htdocs/edit/process/cust_credit.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_credit.cgi: Add a credit (process form) +# $Id: cust_credit.cgi,v 1.7 1999-04-07 15:23:05 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_credit.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-05 -> 96-dec-08 # # post a refund if $new_paybatch @@ -20,51 +18,59 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_credit.cgi,v $ +# Revision 1.7 1999-04-07 15:23:05 ivan +# don't use anchor in redirect +# +# Revision 1.6 1999/02/28 00:03:41 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/25 12:09:59 ivan +# yet more mod_perl stuff +# +# Revision 1.4 1999/01/19 05:13:49 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:47:51 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:18 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $custnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw(popurl); +use FS::Record qw(fields); use FS::cust_credit; -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; -my($custnum)=$1; +$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; +$custnum = $1; -$req->param('otaker',getotaker); +$cgi->param('otaker',getotaker); -my($new) = create FS::cust_credit ( { +$new = new FS::cust_credit ( { map { - $_, $req->param($_); - } qw(custnum _date amount otaker reason) + $_, scalar($cgi->param($_)); + #} qw(custnum _date amount otaker reason) + } fields('cust_credit') } ); -my($error); $error=$new->insert; -&idiot($error) if $error; - -#no errors, no refund, so view our credit. -$req->cgi->redirect("../../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error posting credit/refund</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error posting credit/refund</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again. - </BODY> -</HTML> -END +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); } + diff --git a/htdocs/edit/process/cust_main.cgi b/htdocs/edit/process/cust_main.cgi index 7664dfcb8..a66432ad1 100755 --- a/htdocs/edit/process/cust_main.cgi +++ b/htdocs/edit/process/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_main.cgi: Edit a customer (process form) +# $Id: cust_main.cgi,v 1.10 1999-04-14 07:47:53 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_main.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-04 # # added referral check @@ -20,83 +18,168 @@ # 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.10 1999-04-14 07:47:53 ivan +# i18n fixes +# +# Revision 1.9 1999/04/07 15:22:19 ivan +# don't use anchor in redirect +# +# Revision 1.8 1999/03/25 13:55:10 ivan +# one-screen new customer entry (including package and service) for simple +# packages with one svc_acct service +# +# Revision 1.7 1999/02/28 00:03:42 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:10:00 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:50 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:22:32 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.3 1998/12/17 08:40:19 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 08:57:36 ivan +# i18n, s/CGI-modules/CGI.pm/, FS::CGI::idiot instead of inline, FS::CGI::popurl +# use strict; -use CGI::Request; +use vars qw( $cgi $payby @invoicing_list $new $custnum $error ); +use vars qw( $cust_pkg $cust_svc $svc_acct ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw( popurl ); +use FS::Record qw( qsearch qsearchs fields ); use FS::cust_main; +use FS::type_pkgs; +use FS::agent; -my($req)=new CGI::Request; # create form object +$cgi = new CGI; +&cgisuidsetup($cgi); -&cgisuidsetup($req->cgi); +#unmunge stuff -#create new record object +$cgi->param('tax','') unless defined($cgi->param('tax')); -#unmunge agentnum -$req->param('agentnum', - (split(/:/, ($req->param('agentnum'))[0] ))[0] -); +$cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] ); -#unmunge tax -$req->param('tax','') unless defined($req->param('tax')); +$cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/ + or die "Oops, illegal \"state\" param: ". $cgi->param('state'); +$cgi->param('state', $1); +$cgi->param('county', $3 || ''); +$cgi->param('country', $4); -#unmunge refnum -$req->param('refnum', - (split(/:/, ($req->param('refnum'))[0] ))[0] -); +if ( $payby = $cgi->param('payby') ) { + $cgi->param('payinfo', $cgi->param( $payby. '_payinfo' ) ); + $cgi->param('paydate', + $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' ) ); + $cgi->param('payname', $cgi->param( $payby. '_payname' ) ); +} + +$cgi->param('otaker', &getotaker ); + +@invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') ); +push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST'); -#unmunge state/county -$req->param('state') =~ /^(\w+)( \((\w+)\))?$/; -$req->param('state', $1); -$req->param('county', $3 || ''); +#create new record object -my($new) = create FS::cust_main ( { +$new = new FS::cust_main ( { map { - $_, $req->param("$_") || '' - } qw(custnum agentnum last first ss company address1 address2 city county - state zip country daytime night fax payby payinfo paydate payname tax - otaker refnum) + $_, scalar($cgi->param($_)) +# } qw(custnum agentnum last first ss company address1 address2 city county +# state zip daytime night fax payby payinfo paydate payname tax +# otaker refnum) + } fields('cust_main') } ); -if ( $new->custnum eq '' ) { +#perhaps the invocing_list magic should move to cust_main.pm? +$error = $new->check_invoicing_list( \@invoicing_list ); - my($error)=$new->insert; - &idiot($error) if $error; +#perhaps this stuff should go to cust_main.pm as well +$cust_pkg = ''; +$svc_acct = ''; +if ( $new->custnum eq '' ) { + if ( $cgi->param('pkgpart_svcpart') ) { + my $x = $cgi->param('pkgpart_svcpart'); + $x =~ /^(\d+)_(\d+)$/; + my($pkgpart, $svcpart) = ($1, $2); + #false laziness: copied from FS::cust_pkg::order (which should become a + #FS::cust_main method) + my(%part_pkg); + # generate %part_pkg + # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart + my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum }); + my($type_pkgs); + foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + my($pkgpart)=$type_pkgs->pkgpart; + $part_pkg{$pkgpart}++; + } + #eslaf + + $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't". + "purchase pkgpart ". $pkgpart + unless $part_pkg{ $pkgpart }; + + $cust_pkg = new FS::cust_pkg ( { + #later 'custnum' => $custnum, + 'pkgpart' => $pkgpart, + } ); + $error ||= $cust_pkg->check; + + #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } ); + + #$error ||= $cust_svc->check; + + $svc_acct = new FS::svc_acct ( { + 'svcpart' => $svcpart, + 'username' => $cgi->param('username'), + '_password' => $cgi->param('_password'), + 'popnum' => $cgi->param('popnum'), + } ); + + my $y = $svc_acct->setdefault; # arguably should be in new method + $error ||= $y unless ref($y); + #and just in case you were silly + $svc_acct->svcpart($svcpart); + $svc_acct->username($cgi->param('username')); + $svc_acct->_password($cgi->param('_password')); + $svc_acct->popnum($cgi->param('popnum')); + + $error ||= $svc_acct->check; + + } elsif ( $cgi->param('username') ) { #good thing to catch + $error = "Can't assign username without a package!"; + } + + $error ||= $new->insert; + if ( $cust_pkg && ! $error ) { + $cust_pkg->custnum( $new->custnum ); + $error ||= $cust_pkg->insert; + warn "WARNING: $error on pre-checked cust_pkg record!" if $error; + $svc_acct->pkgnum( $cust_pkg->pkgnum ); + $error ||= $svc_acct->insert; + warn "WARNING: $error on pre-checked svc_acct record!" if $error; + } } else { #create old record object - - my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } ); - &idiot("Old record not found!") unless $old; - my($error)=$new->replace($old); - &idiot($error) if $error; - -} - -my($custnum)=$new->custnum; -$req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_main"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error updating customer information</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error updating customer information</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again. - </BODY> -</HTML> -END - - exit; - + my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } ); + $error ||= "Old record not found!" unless $old; + $error ||= $new->replace($old); } +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string ); +} else { + $new->invoicing_list( \@invoicing_list ); + $custnum = $new->custnum; + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); +} diff --git a/htdocs/edit/process/cust_main_county-expand.cgi b/htdocs/edit/process/cust_main_county-expand.cgi index a821560c6..7e618c7b8 100755 --- a/htdocs/edit/process/cust_main_county-expand.cgi +++ b/htdocs/edit/process/cust_main_county-expand.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/cust_main_county-expand.cgi: Expand counties (process form) +# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:19:07 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -12,45 +12,70 @@ # lose background, FS::CGI # undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record # for that state -#ivan@sisd.com 98-sep-2 +# ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county-expand.cgi,v $ +# Revision 1.6 1999-01-25 12:19:07 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:51 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:52 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/17 08:40:20 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 09:01:40 ivan +# i18n! i18n! +# use strict; -use CGI::Request; +use vars qw ( $cgi $taxnum $cust_main_county @expansion $expansion ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup datasrc); use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(popurl); use FS::cust_main_county; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::cust_main; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; -my($taxnum)=$1; -my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}) +$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; +$taxnum = $1; +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}) or die ("Unknown taxnum!"); -my(@counties); -if ( $req->param('delim') eq 'n' ) { - @counties=split(/\n/,$req->param('counties')); -} elsif ( $req->param('delim') eq 's' ) { - @counties=split(/\s+/,$req->param('counties')); +if ( $cgi->param('delim') eq 'n' ) { + @expansion=split(/\n/,$cgi->param('expansion')); +} elsif ( $cgi->param('delim') eq 's' ) { + @expansion=split(/\s+/,$cgi->param('expansion')); } else { die "Illegal delim!"; } -@counties=map { - /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county"); +@expansion=map { + unless ( /^\s*([\w\- ]+)\s*$/ ) { + $cgi->param('error', "Illegal item in expansion"); + print $cgi->redirect(popurl(2). "cust_main_county-expand.cgi?". $cgi->query_string ); + exit; + } $1; -} @counties; +} @expansion; -my($county); -foreach ( @counties) { +foreach ( @expansion) { my(%hash)=$cust_main_county->hash; - my($new)=create FS::cust_main_county \%hash; + my($new)=new FS::cust_main_county \%hash; $new->setfield('taxnum',''); - $new->setfield('county',$_); + if ( ! $cust_main_county->state ) { + $new->setfield('state',$_); + } else { + $new->setfield('county',$_); + } #if (datasrc =~ m/Pg/) #{ # $new->setfield('tax',0.0); @@ -62,10 +87,11 @@ foreach ( @counties) { unless ( qsearch('cust_main',{ 'state' => $cust_main_county->getfield('state'), 'county' => $cust_main_county->getfield('county'), + 'country' => $cust_main_county->getfield('country'), } ) ) { my($error)=($cust_main_county->delete); die $error if $error; } -$req->cgi->redirect("../../edit/cust_main_county.cgi"); +print $cgi->redirect(popurl(3). "edit/cust_main_county.cgi"); diff --git a/htdocs/edit/process/cust_main_county.cgi b/htdocs/edit/process/cust_main_county.cgi index 58eaa63ce..0fc1708c5 100755 --- a/htdocs/edit/process/cust_main_county.cgi +++ b/htdocs/edit/process/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent.cgi: Edit cust_main_county (process form) +# $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -8,31 +8,53 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.6 1999-01-25 12:19:08 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:52 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:53 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/17 08:40:21 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 09:01:41 ivan +# i18n! i18n! +# use strict; -use CGI::Request; +use vars qw( $cgi ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::Record qw(qsearch qsearchs); use FS::cust_main_county; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -foreach ( $req->params ) { +foreach ( $cgi->param ) { /^tax(\d+)$/ or die "Illegal form $_!"; my($taxnum)=$1; my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}) or die "Couldn't find taxnum $taxnum!"; - next unless $old->getfield('tax') ne $req->param("tax$taxnum"); + next unless $old->getfield('tax') ne $cgi->param("tax$taxnum"); my(%hash)=$old->hash; - $hash{tax}=$req->param("tax$taxnum"); - my($new)=create FS::cust_main_county \%hash; + $hash{tax}=$cgi->param("tax$taxnum"); + my($new)=new FS::cust_main_county \%hash; my($error)=$new->replace($old); - eidiot($error) if $error; + if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string ); + exit; + } } -$req->cgi->redirect("../../browse/cust_main_county.cgi"); +print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi"); diff --git a/htdocs/edit/process/cust_pay.cgi b/htdocs/edit/process/cust_pay.cgi index 9ec97532b..ca5029c3c 100755 --- a/htdocs/edit/process/cust_pay.cgi +++ b/htdocs/edit/process/cust_pay.cgi @@ -1,57 +1,67 @@ #!/usr/bin/perl -Tw # -# process/cust_pay.cgi: Add a payment (process form) +# $Id: cust_pay.cgi,v 1.7 1999-02-28 00:03:43 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_pay.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-11 # # rewrite ivan@sisd.com 98-mar-16 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_pay.cgi,v $ +# Revision 1.7 1999-02-28 00:03:43 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:19:09 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:53 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:54 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:28 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:22 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $invnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::cust_pay qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(fields); +use FS::cust_pay; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($invnum)=$1; +$cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$invnum = $1; -my($new) = create FS::cust_pay ( { +$new = new FS::cust_pay ( { map { - $_, $req->param($_); - } qw(invnum paid _date payby payinfo paybatch) + $_, scalar($cgi->param($_)); + #} qw(invnum paid _date payby payinfo paybatch) + } fields('cust_pay') } ); -my($error); $error=$new->insert; -if ($error) { #error! - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error posting payment</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error posting payment</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again. - </BODY> -</HTML> -END -} else { #no errors! - $req->cgi->redirect("../../view/cust_bill.cgi?$invnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). 'cust_pay.cgi?'. $cgi->query_string ); + exit; +} else { + print $cgi->redirect(popurl(3). "view/cust_bill.cgi?$invnum"); } diff --git a/htdocs/edit/process/cust_pkg.cgi b/htdocs/edit/process/cust_pkg.cgi index 6f5bc875a..9d82b3c24 100755 --- a/htdocs/edit/process/cust_pkg.cgi +++ b/htdocs/edit/process/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/cust_pkg.cgi: Add/edit packages (process form) +# $Id: cust_pkg.cgi,v 1.7 1999-04-07 15:24:06 ivan Exp $ # # this is for changing packages around, not for editing things within the # package @@ -8,8 +8,6 @@ # Usage: post form to: # http://server.name/path/cust_pkg.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 97-mar-21 - 97-mar-24 # # rewrote for new API @@ -19,55 +17,64 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.7 1999-04-07 15:24:06 ivan +# don't use anchor in redirect +# +# Revision 1.6 1999/02/28 00:03:44 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:26 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.3 1999/01/19 05:13:54 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.2 1998/12/17 08:40:23 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::cust_pkg; -my($req)=new CGI::Request; # create form object - -&cgisuidsetup($req->cgi); +$cgi = new CGI; # create form object +&cgisuidsetup($cgi); +$error = ''; #untaint custnum -$req->param('new_custnum') =~ /^(\d+)$/; -my($custnum)=$1; +$cgi->param('custnum') =~ /^(\d+)$/; +$custnum = $1; -my(@remove_pkgnums) = map { +@remove_pkgnums = map { /^(\d+)$/ or die "Illegal remove_pkg value!"; $1; -} $req->param('remove_pkg'); +} $cgi->param('remove_pkg'); -my(@pkgparts); -my($pkgpart); -foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) { - my($num_pkgs)=$req->param("pkg$pkgpart"); - while ( $num_pkgs-- ) { - push @pkgparts,$pkgpart; +foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) { + if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) { + my $num_pkgs = $1; + while ( $num_pkgs-- ) { + push @pkgparts,$pkgpart; + } + } else { + $error = "Illegal quantity"; + last; } } -my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); +$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); if ($error) { - CGI::Base::SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Error updating packages</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error updating packages</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again. - </BODY> -</HTML> -END + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string ); } else { - $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg"); + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); } diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index 7d787819a..adf4672bd 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: part_pkg.cgi,v 1.8 1999-02-07 09:59:27 ivan Exp $ +# # process/part_pkg.cgi: Edit package definitions (process form) # # ivan@sisd.com 97-dec-10 @@ -13,67 +15,117 @@ # 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.8 1999-02-07 09:59:27 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:55 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 22:47:56 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.5 1998/12/30 23:03:29 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 08:40:24 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.3 1998/11/21 07:17:58 ivan +# bugfix to work for regular aswell as custom pricing +# +# Revision 1.2 1998/11/15 13:16:15 ivan +# first pass as per-user custom pricing +# use strict; -use CGI::Request; +use vars qw( $cgi $pkgpart $old $new $part_svc $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::part_pkg qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::part_pkg; use FS::pkg_svc; -use FS::CGI qw(eidiot); +use FS::cust_pkg; -my($req)=new CGI::Request; # create form object +$cgi = new CGI; +&cgisuidsetup($cgi); -&cgisuidsetup($req->cgi); +$pkgpart = $cgi->param('pkgpart'); -my($pkgpart)=$req->param('pkgpart'); +$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; -my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; - -my($new)=create FS::part_pkg ( { +$new = new FS::part_pkg ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('part_pkg') } ); +#most of the stuff below should move to part_pkg.pm + +foreach $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + unless ( $quantity =~ /^(\d+)$/ ) { + $cgi->param('error', "Illegal quantity" ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; + } +} + +local $SIG{HUP} = 'IGNORE'; +local $SIG{INT} = 'IGNORE'; +local $SIG{QUIT} = 'IGNORE'; +local $SIG{TERM} = 'IGNORE'; +local $SIG{TSTP} = 'IGNORE'; +local $SIG{PIPE} = 'IGNORE'; + 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; } -my($part_svc); foreach $part_svc (qsearch('part_svc',{})) { -# don't update non-changing records in part_svc (causing harmless but annoying -# "Records identical" errors). ivan@sisd.com 98-jan-19 - #my($quantity)=$req->param('pkg_svc'. $part_svc->getfield('svcpart')), - my($quantity)=$req->param('pkg_svc'. $part_svc->svcpart) || 0, - my($old_pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - }); - my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; next unless $old_quantity != $quantity; #!here - my($new_pkg_svc)=create FS::pkg_svc({ + my $new_pkg_svc = new FS::pkg_svc( { 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')), + 'svcpart' => $part_svc->svcpart, 'quantity' => $quantity, - }); - if ($old_pkg_svc) { - my($error)=$new_pkg_svc->replace($old_pkg_svc); - eidiot($error) if $error; + } ); + if ( $old_pkg_svc ) { + my $myerror = $new_pkg_svc->replace($old_pkg_svc); + 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; } } -#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart"); -#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart"); -$req->cgi->redirect("../../browse/part_pkg.cgi"); +unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + 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); + 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 08a4c01d0..cde27ede1 100755 --- a/htdocs/edit/process/part_referral.cgi +++ b/htdocs/edit/process/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/part_referral.cgi: Edit referrals (process form) +# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -8,38 +8,58 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# Revision 1.6 1999-02-07 09:59:28 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:56 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:57 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:30 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:25 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $refnum $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_referral qw(fields); -use FS::CGI qw(eidiot); -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearchs fields); +use FS::part_referral; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($refnum)=$req->param('refnum'); +$refnum = $cgi->param('refnum'); -my($new)=create FS::part_referral ( { +$new = new FS::part_referral ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('part_referral') } ); if ( $refnum ) { - my($old)=qsearchs('part_referral',{'refnum'=>$refnum}); - eidiot("(Old) Record not found!") unless $old; - my($error)=$new->replace($old); - eidiot($error) if $error; + my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } ); + die "(Old) Record not found!" unless $old; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; } +$refnum=$new->refnum; -$refnum=$new->getfield('refnum'); -$req->cgi->redirect("../../browse/part_referral.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/part_referral.cgi"); +} diff --git a/htdocs/edit/process/part_svc.cgi b/htdocs/edit/process/part_svc.cgi index 0f0fbc6e8..0b3e2cd1c 100755 --- a/htdocs/edit/process/part_svc.cgi +++ b/htdocs/edit/process/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/part_svc.cgi: Edit service definitions (process form) +# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -8,40 +8,62 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_svc.cgi,v $ +# Revision 1.7 1999-02-07 09:59:29 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:57 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:58 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:31 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:26 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/21 06:43:08 ivan +# s/CGI::Request/CGI.pm/ +# use strict; -use CGI::Request; +use vars qw ( $cgi $svcpart $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_svc qw(fields); -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($svcpart)=$req->param('svcpart'); +$svcpart = $cgi->param('svcpart'); -my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; +$old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; -my($new)=create FS::part_svc ( { +$new = new FS::part_svc ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); # } qw(svcpart svc svcdb) } fields('part_svc') } ); if ( $svcpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $svcpart=$new->getfield('svcpart'); } -#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart"); -#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart"); -$req->cgi->redirect("../../browse/part_svc.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3)."browse/part_svc.cgi"); +} diff --git a/htdocs/edit/process/svc_acct.cgi b/htdocs/edit/process/svc_acct.cgi index 8d77ba703..73e9d5d74 100755 --- a/htdocs/edit/process/svc_acct.cgi +++ b/htdocs/edit/process/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_acct.cgi: Add/edit a customer (process form) +# $Id: svc_acct.cgi,v 1.6 1999-02-28 00:03:45 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi # -# Note: Should br run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-18 # # Changed /u to /u2 @@ -21,67 +19,69 @@ # 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.6 1999-02-28 00:03:45 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:30 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:58 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:47:59 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:27 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::CGI qw(popurl); +use FS::Record qw(qsearchs fields); use FS::svc_acct; -my($req) = new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; -my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum; +$old = qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum; #unmunge popnum -$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] ); +$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] ); #unmunge passwd -if ( $req->param('_password') eq '*HIDDEN*' ) { - $req->param('_password',$old->getfield('_password')); +if ( $cgi->param('_password') eq '*HIDDEN*' ) { + $cgi->param('_password',$old->getfield('_password')); } -my($new) = create FS::svc_acct ( { +$new = new FS::svc_acct ( { map { - $_, $req->param($_); - } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir - shell quota slipip) + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir + # shell quota slipip) + } ( fields('svc_acct'), qw( pkgnum svcpart ) ) } ); if ( $svcnum ) { - my($error) = $new->replace($old); - &idiot($error) if $error; + $error = $new->replace($old); } else { - my($error) = $new->insert; - &idiot($error) if $error; - $svcnum = $new->getfield('svcnum'); + $error = $new->insert; + $svcnum = $new->svcnum; } -#no errors, view account -$req->cgi->redirect("../../view/svc_acct.cgi?" . $svcnum ); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error adding/updating account</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error adding/updating account</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again. - </BODY> -</HTML> -END - exit; +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); } diff --git a/htdocs/edit/process/svc_acct_pop.cgi b/htdocs/edit/process/svc_acct_pop.cgi index 18d7940b4..763bca4a8 100755 --- a/htdocs/edit/process/svc_acct_pop.cgi +++ b/htdocs/edit/process/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/svc_acct_pop.cgi: Edit POP (process form) +# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,36 +8,59 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.6 1999-02-07 09:59:31 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:59 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:48:00 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:32 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:28 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $popnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct_pop qw(fields); -use FS::CGI qw(eidiot); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_pop; +use FS::CGI qw(popurl); -my($req)=new CGI::Request; # create form object +$cgi = new CGI; # create form object -&cgisuidsetup($req->cgi); +&cgisuidsetup($cgi); -my($popnum)=$req->param('popnum'); +$popnum = $cgi->param('popnum'); -my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; +$old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; -my($new)=create FS::svc_acct_pop ( { +$new = new FS::svc_acct_pop ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('svc_acct_pop') } ); if ( $popnum ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $popnum=$new->getfield('popnum'); } -$req->cgi->redirect("../../browse/svc_acct_pop.cgi"); + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi"); +} diff --git a/htdocs/edit/process/svc_acct_sm.cgi b/htdocs/edit/process/svc_acct_sm.cgi index 9ad546bf4..9c39bb8e5 100755 --- a/htdocs/edit/process/svc_acct_sm.cgi +++ b/htdocs/edit/process/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_acct_sm.cgi: Add/edit a mail alias (process form) +# $Id: svc_acct_sm.cgi,v 1.6 1999-02-28 00:03:46 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct_sm.cgi # -# Note: Should br run setuid root as user nobody. -# # lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled. # # ivan@voicenet.com 97-jan-6 @@ -22,33 +20,53 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.6 1999-02-28 00:03:46 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:32 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:00 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:48:01 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:29 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearchs fields); use FS::svc_acct_sm; +use FS::CGI qw(popurl); -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum =$1; -my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; +$old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; #unmunge domsvc and domuid -$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] ); -$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] ); +#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); +#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); -my($new) = create FS::svc_acct_sm ( { +$new = new FS::svc_acct_sm ( { map { - ($_, scalar($req->param($_))); - } qw(svcnum pkgnum svcpart domuser domuid domsvc) + ($_, scalar($cgi->param($_))); + #} qw(svcnum pkgnum svcpart domuser domuid domsvc) + } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) ) } ); -my($error); if ( $svcnum ) { $error = $new->replace($old); } else { @@ -56,25 +74,10 @@ if ( $svcnum ) { $svcnum = $new->getfield('svcnum'); } -unless ($error) { - $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string ); } else { - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error adding/editing mail alias</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error adding/editing mail alias</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again. - </BODY> -</HTML> -END - + print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum"); } diff --git a/htdocs/edit/process/svc_domain.cgi b/htdocs/edit/process/svc_domain.cgi index 0782772dd..e12aa1b55 100755 --- a/htdocs/edit/process/svc_domain.cgi +++ b/htdocs/edit/process/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_domain.cgi: Add a domain (process form) +# $Id: svc_domain.cgi,v 1.6 1999-02-28 00:03:47 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should br run setuid root as user nobody. -# # lots of yucky stuff in this one... bleachlkjhui! # # ivan@voicenet.com 97-jan-6 @@ -18,61 +16,65 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.6 1999-02-28 00:03:47 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:33 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:01 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:48:02 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:30 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearchs fields); use FS::svc_domain; +use FS::CGI qw(popurl); #remove this to actually test the domains! $FS::svc_domain::whois_hack = 1; -my($req) = new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; -my($new) = create FS::svc_domain ( { +$new = new FS::svc_domain ( { map { - $_, $req->param($_); - } qw(svcnum pkgnum svcpart domain action purpose) + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart domain action purpose) + } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) ) } ); -my($error); -if ($req->param('legal') ne "Yes") { +if ($cgi->param('legal') ne "Yes") { $error = "Customer did not agree to be bound by NSI's ". qq!<A HREF="http://rs.internic.net/help/agreement.txt">!. "Domain Name Resgistration Agreement</A>"; -} elsif ($req->param('svcnum')) { +} elsif ($cgi->param('svcnum')) { $error="Can't modify a domain!"; } else { $error=$new->insert; $svcnum=$new->svcnum; } -unless ($error) { - $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string ); } else { - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error adding domain</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error adding domain</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again. - </BODY> -</HTML> -END - + print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); } - diff --git a/htdocs/edit/svc_acct.cgi b/htdocs/edit/svc_acct.cgi index 61d0fdc28..a8c4cfb39 100755 --- a/htdocs/edit/svc_acct.cgi +++ b/htdocs/edit/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_acct.cgi: Add/edit account (output form) +# $Id: svc_acct.cgi,v 1.9 1999-02-28 00:03:37 ivan Exp $ # # Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 96-dec-18 # # rewrite ivan@sisd.com 98-mar-8 @@ -16,100 +14,130 @@ # 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.9 1999-02-28 00:03:37 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/23 08:09:22 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.7 1999/02/07 09:59:22 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:43 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:32 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 23:03:22 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 06:17:08 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart + $part_svc $svc $otaker $username $password $ulen $ulen2 $p1 + $popnum $uid $gid $finger $dir $shell $quota $slipip ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct qw(fields); - -my($shells)="/var/spool/freeside/conf/shells"; -open(SHELLS,$shells) or die "Can't open $shells: $!"; -my(@shells)=map { - /^([\/\w]*)$/ or die "Illegal shell in conf/shells!"; - $1; -} grep $_ !~ /^#/, <SHELLS>; - -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); - -my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc); - -if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct) svcnum!"; +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct; +use FS::Conf; - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +$cgi = new CGI; +&cgisuidsetup($cgi); - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; +$conf = new FS::Conf; +@shells = $conf->config('shells'); +if ( $cgi->param('error') ) { + $svc_acct = new FS::svc_acct ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct') + } ); + $svcnum = $svc_acct->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct) svcnum!"; - $action="Edit"; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; -} else { #adding + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $svc_acct=create FS::svc_acct({}); + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$QUERY_STRING)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; - - $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'; -my($svc)=$part_svc->getfield('svc'); +$svc = $part_svc->getfield('svc'); -my($otaker)=getotaker; +$otaker = getotaker; -my($username,$password)=( +($username,$password)=( $svc_acct->username, $svc_acct->_password ? "*HIDDEN*" : '', ); -my($ulen)=$svc_acct->dbdef_table->column('username')->length; -my($ulen2)=$ulen+2; +$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'); -SendHeaders(); print <<END; -<HTML> - <HEAD> - <TITLE>$action $svc account</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>$action $svc account</H1> - </CENTER><HR> - <FORM ACTION="process/svc_acct.cgi" METHOD=POST> + <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> @@ -121,7 +149,7 @@ Username: END #pop -my($popnum)=$svc_acct->popnum || 0; +$popnum = $svc_acct->popnum || 0; if ( $part_svc->svc_acct__popnum_flag eq "F" ) { print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!; } else { @@ -132,14 +160,14 @@ if ( $part_svc->svc_acct__popnum_flag eq "F" ) { $svc_acct_pop->popnum, ": ", $svc_acct_pop->city, ", ", $svc_acct_pop->state, - "(", $svc_acct_pop->ac, ")/", + " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "\n" ; } print "</SELECT>"; } -my($uid,$gid,$finger,$dir)=( +($uid,$gid,$finger,$dir)=( $svc_acct->uid, $svc_acct->gid, $svc_acct->finger, @@ -153,7 +181,7 @@ print <<END; <INPUT TYPE="hidden" NAME="dir" VALUE="$dir"> END -my($shell)=$svc_acct->shell; +$shell = $svc_acct->shell; if ( $part_svc->svc_acct__shell_flag eq "F" ) { print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!; } else { @@ -166,7 +194,7 @@ if ( $part_svc->svc_acct__shell_flag eq "F" ) { print "</SELECT>"; } -my($quota,$slipip)=( +($quota,$slipip)=( $svc_acct->quota, $svc_acct->slipip, ); diff --git a/htdocs/edit/svc_acct_pop.cgi b/htdocs/edit/svc_acct_pop.cgi index 46d803f07..d6e2e5d3d 100755 --- a/htdocs/edit/svc_acct_pop.cgi +++ b/htdocs/edit/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct_pop.cgi: Add/Edit pop (output form) +# $Id: svc_acct_pop.cgi,v 1.8 1999-02-23 08:09:23 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,38 +8,69 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.8 1999-02-23 08:09:23 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.7 1999/02/07 09:59:23 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:44 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:33 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 02:57:45 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:10 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/13 09:56:47 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base; +use vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); +use FS::CGI qw(header menubar popurl); use FS::svc_acct_pop; -use FS::CGI qw(header menubar); - -my($cgi) = new CGI::Base; -$cgi->get; - +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($svc_acct_pop,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $svc_acct_pop = new FS::svc_acct_pop ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop') + } ); +} elsif ( $cgi->keywords ) { #editing + my($query)=$cgi->keywords; + $query =~ /^(\d+)$/; $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1}); - $action='Edit'; } else { #adding - $svc_acct_pop=create FS::svc_acct_pop {}; - $action='Add'; + $svc_acct_pop = new FS::svc_acct_pop {}; } -my($hashref)=$svc_acct_pop->hashref; +$action = $svc_acct_pop->popnum ? 'Edit' : 'Add'; +$hashref = $svc_acct_pop->hashref; -print header("$action POP", menubar( - 'Main Menu' => '../', - 'View all POPs' => "../browse/svc_acct_pop.cgi", -)), <<END; - <FORM ACTION="process/svc_acct_pop.cgi" METHOD=POST> -END +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar( + 'Main Menu' => popurl(2), + 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi", +)); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!; #display @@ -49,7 +80,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 45a8eb8fc..cb7cbfae0 100755 --- a/htdocs/edit/svc_acct_sm.cgi +++ b/htdocs/edit/svc_acct_sm.cgi @@ -1,14 +1,12 @@ #!/usr/bin/perl -Tw # -# svc_acct_sm.cgi: Add/edit a mail alias (output form) +# $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:03:38 ivan Exp $ # # Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # # use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add # -# Note: Should be run setuid freeside as user nobody. -# # should error out in a more CGI-friendly way, and should have more error checking (sigh). # # ivan@voicenet.com 97-jan-5 @@ -33,71 +31,102 @@ # rewrite ivan@sisd.com 98-mar-15 # # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.9 1999-02-28 00:03:38 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/07 09:59:24 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:45 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:34 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:24 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/23 02:58:45 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:11 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/12/16 05:19:15 ivan +# use FS::Conf +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $conf $cgi $mydomain $action $svcnum $svc_acct_sm $pkgnum $svcpart + $part_svc $query %username %domain $p1 $domuser $domsvc $domuid ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct_sm qw(fields); - -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1 -} grep $_ !~ /^(#|$)/, <DOMAIN>; -close DOMAIN; - -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); - -SendHeaders(); # one guess. +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_sm; +use FS::Conf; -my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc); -if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct_sm) svcnum!"; +$cgi = new CGI; +&cgisuidsetup($cgi); - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; - +if ( $cgi->param('error') ) { + $svc_acct_sm = new FS::svc_acct_sm ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm') + } ); + $svcnum = $svc_acct_sm->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct_sm) svcnum!"; - $action="Edit"; - -} else { #adding + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $svc_acct_sm=create FS::svc_acct_sm({}); + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + } else { #adding - $svcnum=''; + $svc_acct_sm = new FS::svc_acct_sm({}); - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct_sm') ) { - if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { - $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; } - } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $action='Add'; + $svcnum=''; + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct_sm') ) { + if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { + $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + } + } + + } } +$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add'; -my(%username,%domain); if ($pkgnum) { #find all possible uids (and usernames) @@ -155,17 +184,14 @@ if ($pkgnum) { die "\$action eq Add, but \$pkgnum is null!\n"; } -print <<END; -<HTML> - <HEAD> - <TITLE>Mail Alias $action</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Mail Alias $action</H1> - </CENTER> - <FORM ACTION="process/svc_acct_sm.cgi" METHOD=POST> -END +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", ''); + +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); + +print qq!<FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST>!; #display @@ -182,7 +208,7 @@ print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!; #svcpart print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!; -my($domuser,$domsvc,$domuid)=( +($domuser,$domsvc,$domuid)=( $svc_acct_sm->domuser, $svc_acct_sm->domsvc, $svc_acct_sm->domuid, @@ -194,14 +220,16 @@ print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * #domsvc print qq! \@ <SELECT NAME="domsvc" SIZE=1>!; foreach $_ (keys %domain) { - print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}"; + print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", + qq! VALUE="$_">$domain{$_}!; } print "</SELECT>"; #uid print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!; foreach $_ (keys %username) { - print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}"; + print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", + qq! VALUE="$_">$username{$_}!; } print "</SELECT>\@$mydomain mailbox."; diff --git a/htdocs/edit/svc_domain.cgi b/htdocs/edit/svc_domain.cgi index 0717a2c09..6b5eff560 100755 --- a/htdocs/edit/svc_domain.cgi +++ b/htdocs/edit/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_domain.cgi: Add domain (output form) +# $Id: svc_domain.cgi,v 1.9 1999-02-28 00:03:39 ivan Exp $ # # Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart} # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 97-jan-5 -> 97-jan-6 # # changes for domain template 3.5 @@ -15,92 +13,137 @@ # rewrite ivan@sisd.com 98-mar-14 # # no GOV in instructions ivan@sisd.com 98-jul-17 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.9 1999-02-28 00:03:39 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/07 09:59:25 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:46 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:35 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:25 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/23 03:00:16 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:12 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/13 09:56:48 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc + $svc $otaker $domain $p1 $kludge_action $purpose ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); -use FS::svc_domain qw(fields); +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_domain; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc); - -if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) - or die "Unknown (svc_domain) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +if ( $cgi->param('error') ) { + $svc_domain = new FS::svc_domain ( { + map { $_, scalar($cgi->param($_)) } fields('svc_domain') + } ); + $svcnum = $svc_domain->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); + $kludge_action = $cgi->param('action'); + $purpose = $cgi->param('purpose'); + $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); + die "No part_svc entry!" unless $part_svc; +} else { + $kludge_action = ''; + $purpose = ''; + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) + or die "Unknown (svc_domain) svcnum!"; - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $action="Edit"; + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; -} else { #adding + } else { #adding - $svc_domain=create FS::svc_domain({}); + $svc_domain = new FS::svc_domain({}); - foreach $_ (split(/-/,$QUERY_STRING)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $svcnum=''; + $svcnum=''; - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_domain') ) { - if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { - $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_domain') ) { + if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { + $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + } } + } +} +$action = $svcnum ? 'Edit' : 'Add'; - $action="Add"; +$svc = $part_svc->getfield('svc'); -} +$otaker = getotaker; -my($svc)=$part_svc->getfield('svc'); +$domain = $svc_domain->domain; -my($otaker)=getotaker; +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''); -my($domain)=( - $svc_domain->domain, -); +print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), + "</FONT>" + if $cgi->param('error'); -SendHeaders(); print <<END; -<HTML> - <HEAD> - <TITLE>$action $svc</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>$action $svc</H1> - </CENTER><HR> - <FORM ACTION="process/svc_domain.cgi" METHOD=POST> + <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST> <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum"> <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart"> - <INPUT TYPE="radio" NAME="action" VALUE="N">New - <BR><INPUT TYPE="radio" NAME="action" VALUE="M">Transfer +END +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 @@ -112,7 +155,8 @@ Domain Name Registration Agreement</A> </UL> US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain and registration procedures. -<P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816). +<!-- <P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816). +!--> </FORM> </BODY> </HTML> diff --git a/htdocs/images/sisd.jpg b/htdocs/images/sisd.jpg Binary files differdeleted file mode 100755 index 908a5eaff..000000000 --- a/htdocs/images/sisd.jpg +++ /dev/null diff --git a/htdocs/index.html b/htdocs/index.html index de0667e59..052aed3ed 100755 --- a/htdocs/index.html +++ b/htdocs/index.html @@ -14,16 +14,17 @@ </td></tr> </table> <A HREF="http://www.sisd.com/freeside"> - Information + Freeside home page </A> <BR><A HREF="docs/"> Documentation </A> </P> <HR> - <H3><A HREF="edit/cust_main.cgi">New Customer</A></H3> - <A NAME="search"><H3>Search</H3></A> - <MENU> + <ul> + <li><A HREF="edit/cust_main.cgi">New Customer</A> + <li><A NAME="search">Search</A> + <ul> <LI><A HREF="search/cust_main.html"> customers (by last name and/or company) </A> @@ -32,9 +33,9 @@ <LI><A HREF="search/svc_domain.html">domains (by domain)</A> <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A> <LI><A HREF="search/cust_bill.html">invoices (by invoice number)</A> - </MENU> - <A NAME="browse"><H3>Browse</H3></A> - <MENU> + </ul> + <li><A NAME="browse">Browse</A> + <ul> <LI><A HREF="search/cust_main.cgi?custnum">customers (by customer number)</A> <LI><A HREF="search/cust_main.cgi?last">customers (by last name)</A> <LI><A HREF="search/cust_main.cgi?company">customers (by company)</A> @@ -50,15 +51,15 @@ <LI><A HREF="search/svc_domain.cgi?domain">domains (by domain)</A> <LI><A HREF="search/svc_domain.cgi?UN_svcnum">unlinked domains (by service number)</A> <LI><A HREF="search/svc_domain.cgi?UN_domain">unlinked domains (by domain)</A> - </MENU> - <A NAME="admin"><H3>Administration</H3></a> - <MENU> + </ul> + <li><A NAME="admin">Administration</a> + <ul> <LI><A HREF="browse/part_svc.cgi"> - View/Edit services + View/Edit service definitions </A> - Services are items you offer to your customers. <LI><A HREF="browse/part_pkg.cgi"> - View/Edit packages + View/Edit package definitions </A> - One or more services are grouped together into a package and given pricing information. Customers purchase packages, not @@ -66,31 +67,28 @@ <LI><A HREF="browse/agent_type.cgi"> View/Edit agent types </A> - - Agent types define groups of packages that you can then assign - to particular agents. + - Agent types define groups of package definitions that you can + then assign to particular agents. <LI><A HREF="browse/agent.cgi"> View/Edit agents </A> - Agents are resellers of your service. Agents may be limited - to a subset of your full offerings (via their agent type). - <BR> + to a subset of your full offerings (via their type). <LI><A HREF="browse/part_referral.cgi"> View/Edit referrals </A> - Where a customer heard about your service. Tracked for informational purposes. - <BR> <LI><A HREF="browse/cust_main_county.cgi"> View/Edit locales and tax rates </A> - - Change tax rates by state, or break down a state into counties - and assign different tax rates to each county. - <BR> + - Change tax rates, or break down a country into states, or a state + into counties and assign different tax rates to each. <LI><A HREF="browse/svc_acct_pop.cgi"> View/Edit POPs </A> - Points of Presence - </MENU> - </FONT> + </ul> + </ul> </BODY> </HTML> diff --git a/htdocs/misc/bill.cgi b/htdocs/misc/bill.cgi index d41f6d1c9..2c17baec7 100755 --- a/htdocs/misc/bill.cgi +++ b/htdocs/misc/bill.cgi @@ -1,36 +1,47 @@ #!/usr/bin/perl -Tw # +# $Id: bill.cgi,v 1.4 1999-01-19 05:14:02 ivan Exp $ +# # s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: bill.cgi,v $ +# Revision 1.4 1999-01-19 05:14:02 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:01:13 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:41 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $query $custnum $cust_main $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); -use FS::Bill; +use FS::cust_main; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint custnum -$QUERY_STRING =~ /^(\d*)$/; -my($custnum)=$1; -my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); +($query) = $cgi->keywords; +$query =~ /^(\d*)$/; +$custnum = $1; +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); die "Can't find customer!\n" unless $cust_main; -# ? -bless($cust_main,"FS::Bill"); - -my($error); - $error = $cust_main->bill( # 'time'=>$time ); -&idiot($error) if $error; +&eidiot($error) if $error; $error = $cust_main->collect( # 'invoice-time'=>$time, @@ -38,29 +49,7 @@ $error = $cust_main->collect( 'batch_card'=> 'no', 'report_badcard'=> 'yes', ); -&idiot($error) if $error; - -$cgi->redirect("../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error billing customer</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error billing customer</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - </BODY> -</HTML> -END - - exit; +&eidiot($error) if $error; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history"); diff --git a/htdocs/misc/cancel-unaudited.cgi b/htdocs/misc/cancel-unaudited.cgi index 929274f38..78b7d3175 100755 --- a/htdocs/misc/cancel-unaudited.cgi +++ b/htdocs/misc/cancel-unaudited.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cancel-unaudited.cgi: Cancel an unaudited account +# $Id: cancel-unaudited.cgi,v 1.6 1999-02-28 00:03:48 ivan Exp $ # # Usage: cancel-unaudited.cgi svcnum # http://server.name/path/cancel-unaudited.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 97-apr-23 # # rewrote for new API @@ -16,29 +14,49 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cancel-unaudited.cgi,v $ +# Revision 1.6 1999-02-28 00:03:48 ivan +# removed misleading comments +# +# 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/; +# +# Revision 1.3 1998/12/23 03:02:05 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:42 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); use FS::cust_svc; use FS::svc_acct; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; -my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum}); -&idiot("Unknown svcnum!") unless $svc_acct; +$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum}); +die "Unknown svcnum!" unless $svc_acct; -my($cust_svc) = qsearchs('cust_svc',{'svcnum'=>$svcnum}); -&idiot(qq!This account has already been audited. Cancel the - <A HREF="../view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') . +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +&eidiot(qq!This account has already been audited. Cancel the + <A HREF="!. popurl(2). qq!view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') . qq!pkgnum"> package</A> instead.!) if $cust_svc->getfield('pkgnum') ne ''; @@ -48,38 +66,13 @@ local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; -my($error); - -bless($svc_acct,"FS::svc_acct"); $error = $svc_acct->cancel; -&idiot($error) if $error; +&eidiot($error) if $error; $error = $svc_acct->delete; -&idiot($error) if $error; +&eidiot($error) if $error; -bless($cust_svc,"FS::cust_svc"); $error = $cust_svc->delete; -&idiot($error) if $error; - -$cgi->redirect("../"); +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Error cancelling account</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Error cancelling account</H1> - </CENTER> - <HR> - There has been an error cancelling this acocunt: $error - </BODY> - </HEAD> -</HTML> -END - exit; -} +print $cgi->redirect(popurl(2)); diff --git a/htdocs/misc/cancel_pkg.cgi b/htdocs/misc/cancel_pkg.cgi index 6702a0351..7bbcf6e7f 100755 --- a/htdocs/misc/cancel_pkg.cgi +++ b/htdocs/misc/cancel_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cancel_pkg.cgi: Cancel a package +# $Id: cancel_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $ # # Usage: cancel_pkg.cgi pkgnum # http://server.name/path/cancel_pkg.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!! # # probably should generalize this to do cancels, suspensions, unsuspensions, etc. @@ -27,28 +25,47 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cancel_pkg.cgi,v $ +# Revision 1.6 1999-04-08 10:35:02 ivan +# import necessary subroutines from FS::CGI +# +# Revision 1.5 1999/02/28 00:03:49 ivan +# removed misleading comments +# +# Revision 1.4 1999/01/19 05:14:04 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:02:54 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:43 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw ( $cgi $query $pkgnum $cust_pkg $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(eidiot popurl); use FS::Record qw(qsearchs); +use FS::CGI qw(popurl eidiot); use FS::cust_pkg; -use FS::CGI qw(idiot); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum"; -my($pkgnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/ || die "Illegal pkgnum"; +$pkgnum = $1; -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -bless($cust_pkg,'FS::cust_pkg'); -my($error)=$cust_pkg->cancel; -idiot($error) if $error; +$error = $cust_pkg->cancel; +eidiot($error) if $error; -$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/misc/expire_pkg.cgi b/htdocs/misc/expire_pkg.cgi index 163516627..cf1f23153 100755 --- a/htdocs/misc/expire_pkg.cgi +++ b/htdocs/misc/expire_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# expire_pkg.cgi: Expire a package +# $Id: expire_pkg.cgi,v 1.4 1999-02-28 00:03:50 ivan Exp $ # # Usage: post form to: # http://server.name/path/expire_pkg.cgi # -# Note: Should be run setuid freeside as user nobody -# # based on susp_pkg # ivan@voicenet.com 97-jul-29 # @@ -14,58 +12,50 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: expire_pkg.cgi,v $ +# Revision 1.4 1999-02-28 00:03:50 ivan +# removed misleading comments +# +# Revision 1.3 1999/01/19 05:14:05 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 09:12:44 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; +use vars qw ( $cgi $date $pkgnum $cust_pkg %hash $new $error ); use Date::Parse; -use CGI::Request; +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); use FS::cust_pkg; -my($req) = new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); #untaint date & pkgnum -my($date); -if ( $req->param('date') ) { - str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date"; +if ( $cgi->param('date') ) { + str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date"; $date=$1; } else { $date=''; } -$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum"; -my($pkgnum)=$1; +$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum"; +$pkgnum = $1; -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -my(%hash)=$cust_pkg->hash; +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +%hash = $cust_pkg->hash; $hash{expire}=$date; -my($new)=create FS::cust_pkg ( \%hash ); -my($error) = $new->replace($cust_pkg); -&idiot($error) if $error; - -$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +$new = new FS::cust_pkg ( \%hash ); +$error = $new->replace($cust_pkg); +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Error expiring package</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Error expiring package</H1> - </CENTER> - <HR> - There has been an error expiring this package: $error - </BODY> - </HEAD> -</HTML> -END - exit; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/misc/link.cgi b/htdocs/misc/link.cgi index d1db000ec..eb1780711 100755 --- a/htdocs/misc/link.cgi +++ b/htdocs/misc/link.cgi @@ -1,21 +1,45 @@ #!/usr/bin/perl -Tw # -# link: instead of adding a new account, link to an existing. (output form) -# -# Note: Should be run setuid freeside as user nobody +# $Id: link.cgi,v 1.7 1999-04-08 11:31:40 ivan Exp $ # # ivan@voicenet.com 97-feb-5 # # rewrite ivan@sisd.com 98-mar-17 # # can also link on some other fields now (about time) ivan@sisd.com 98-jun-24 +# +# $Log: link.cgi,v $ +# Revision 1.7 1999-04-08 11:31:40 ivan +# *** empty log message *** +# +# Revision 1.6 1999/02/28 00:03:51 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/19 05:14:06 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:36 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/23 03:03:39 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:45 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw ( %link_field $cgi $pkgnum $svcpart $query $part_svc $svc $svcdb + $link_field ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl header); use FS::Record qw(qsearchs); -my(%link_field)=( +%link_field = ( 'svc_acct' => 'username', 'svc_domain' => 'domain', 'svc_acct_sm' => '', @@ -23,33 +47,22 @@ my(%link_field)=( 'svc_wo' => '', ); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -my($pkgnum,$svcpart); -foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart +($query) = $cgi->keywords; +foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart $pkgnum=$1 if /^pkgnum(\d+)$/; $svcpart=$1 if /^svcpart(\d+)$/; } -my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart}); -my($svc) = $part_svc->getfield('svc'); -my($svcdb) = $part_svc->getfield('svcdb'); -my($link_field) = $link_field{$svcdb}; +$part_svc = qsearchs('part_svc',{'svcpart'=>$svcpart}); +$svc = $part_svc->getfield('svc'); +$svcdb = $part_svc->getfield('svcdb'); +$link_field = $link_field{$svcdb}; -CGI::Base::SendHeaders(); -print <<END; -<HTML> - <HEAD> - <TITLE>Link to existing $svc account</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Link to existing $svc account</H1> - </CENTER><HR> - <FORM ACTION="process/link.cgi" METHOD=POST> -END +print $cgi->header( '-expires' => 'now' ), header("Link to existing $svc"), + qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!; if ( $link_field ) { print <<END; diff --git a/htdocs/misc/print-invoice.cgi b/htdocs/misc/print-invoice.cgi index 084dcc1c4..213f15406 100755 --- a/htdocs/misc/print-invoice.cgi +++ b/htdocs/misc/print-invoice.cgi @@ -1,57 +1,51 @@ #!/usr/bin/perl -Tw # +# $Id: print-invoice.cgi,v 1.4 1999-01-19 05:14:07 ivan Exp $ +# # just a kludge for now, since this duplicates in a way it shouldn't stuff from # Bill.pm (like $lpr) ivan@sisd.com 98-jun-16 +# +# $Log: print-invoice.cgi,v $ +# Revision 1.4 1999-01-19 05:14:07 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:04:24 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:47 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw($conf $cgi $lpr $query $invnum $cust_bill $custnum ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::Record qw(qsearchs); -use FS::Invoice; - -my($lpr) = "|lpr -h"; +use FS::cust_bill; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); +$conf = new FS::Conf; +$lpr = $conf->config('lpr'); + #untaint invnum -$QUERY_STRING =~ /^(\d*)$/; -my($invnum)=$1; -my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum}); +($query) = $cgi->keywords; +$query =~ /^(\d*)$/; +$invnum = $1; +$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum}); die "Can't find invoice!\n" unless $cust_bill; - bless($cust_bill,"FS::Invoice"); - open(LPR,$lpr) or die "Can't open $lpr: $!"; + open(LPR,"|$lpr") or die "Can't open $lpr: $!"; print LPR $cust_bill->print_text; #( date ) close LPR or die $! ? "Error closing $lpr: $!" : "Exit status $? from $lpr"; -my($custnum)=$cust_bill->getfield('custnum'); - -$cgi->redirect("../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error printing invoice</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error printing invoice</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - </BODY> -</HTML> -END - - exit; - -} +$custnum = $cust_bill->getfield('custnum'); + +print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history"); diff --git a/htdocs/misc/process/link.cgi b/htdocs/misc/process/link.cgi index 23fb05386..808299415 100755 --- a/htdocs/misc/process/link.cgi +++ b/htdocs/misc/process/link.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/link.cgi: link to existing customer (process form) +# $Id: link.cgi,v 1.4 1999-02-07 09:59:35 ivan Exp $ # # ivan@voicenet.com 97-feb-5 # @@ -10,64 +10,58 @@ # bmccane@maxbaud.net 98-apr-3 # # can also link on some other fields now (about time) ivan@sisd.com 98-jun-24 +# +# $Log: link.cgi,v $ +# 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/; +# +# Revision 1.2 1998/12/17 09:15:00 ivan +# s/CGI::Request/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::CGI qw(idiot); +use FS::CGI qw(popurl idiot); use FS::UID qw(cgisuidsetup); use FS::cust_svc; use FS::Record qw(qsearchs); -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); - -#$req->import_names('R'); #import CGI variables into package 'R'; +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1; -$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1; +$cgi->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1; +$cgi->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1; -$req->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1; unless ( $svcnum ) { my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart}); my($svcdb) = $part_svc->getfield('svcdb'); - $req->param('link_field') =~ /^(\w+)$/; my($link_field)=$1; - my($svc_acct)=qsearchs($svcdb,{$link_field => $req->param('link_value') }); - idiot("$link_field not found!") unless $svc_acct; + $cgi->param('link_field') =~ /^(\w+)$/; my($link_field)=$1; + my($svc_acct)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') }); + eidiot("$link_field not found!") unless $svc_acct; $svcnum=$svc_acct->svcnum; } -my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$old = qsearchs('cust_svc',{'svcnum'=>$svcnum}); die "svcnum not found!" unless $old; -my($new)=create FS::cust_svc ({ +$new = new FS::cust_svc ({ 'svcnum' => $svcnum, 'pkgnum' => $pkgnum, 'svcpart' => $svcpart, }); -my($error); $error = $new->replace($old); unless ($error) { #no errors, so let's view this customer. - $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum"); + print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum"); } else { - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Error</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Error</H4> - </CENTER> - Your update did not occur because of the following error: - <P><B>$error</B> - <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again. - </BODY> -</HTML> -END - + idiot($error); } diff --git a/htdocs/misc/susp_pkg.cgi b/htdocs/misc/susp_pkg.cgi index 7b23caeb2..abe4f70b0 100755 --- a/htdocs/misc/susp_pkg.cgi +++ b/htdocs/misc/susp_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# susp_pkg.cgi: Suspend a package +# $Id: susp_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $ # # Usage: susp_pkg.cgi pkgnum # http://server.name/path/susp_pkg.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # probably should generalize this to do cancels, suspensions, unsuspensions, etc. # # ivan@voicenet.com 97-feb-27 @@ -21,48 +19,46 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: susp_pkg.cgi,v $ +# Revision 1.6 1999-04-08 10:35:02 ivan +# import necessary subroutines from FS::CGI +# +# Revision 1.5 1999/02/28 00:03:52 ivan +# removed misleading comments +# +# Revision 1.4 1999/01/19 05:14:08 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:04:56 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:48 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi $query $pkgnum $cust_pkg $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs); +use FS::CGI qw(popurl eidiot); use FS::cust_pkg; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum"; -my($pkgnum)=$1; - -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +($query) = $cgi->keywords; +$query =~ /^(\d+)$/ || die "Illegal pkgnum"; +$pkgnum = $1; -bless($cust_pkg,'FS::cust_pkg'); -my($error)=$cust_pkg->suspend; -&idiot($error) if $error; +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +$error = $cust_pkg->suspend; +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Error suspending package</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Error suspending package</H1> - </CENTER> - <HR> - There has been an error suspending this package: $error - </BODY> - </HEAD> -</HTML> -END - exit; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/misc/unsusp_pkg.cgi b/htdocs/misc/unsusp_pkg.cgi index 2f340c6fa..9e60064c3 100755 --- a/htdocs/misc/unsusp_pkg.cgi +++ b/htdocs/misc/unsusp_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# susp_pkg.cgi: Unsuspend a package +# $Id: unsusp_pkg.cgi,v 1.5 1999-02-28 00:03:53 ivan Exp $ # # Usage: susp_pkg.cgi pkgnum # http://server.name/path/susp_pkg.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # probably should generalize this to do cancels, suspensions, unsuspensions, etc. # # ivan@voicenet.com 97-feb-27 @@ -21,48 +19,43 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: unsusp_pkg.cgi,v $ +# Revision 1.5 1999-02-28 00:03:53 ivan +# removed misleading comments +# +# Revision 1.4 1999/01/19 05:14:09 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:05:25 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:49 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi $query $pkgnum $cust_pkg $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); use FS::cust_pkg; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum"; -my($pkgnum)=$1; - -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +($query) = $cgi->keywords; +$query =~ /^(\d+)$/ || die "Illegal pkgnum"; +$pkgnum = $1; -bless($cust_pkg,'FS::cust_pkg'); -my($error)=$cust_pkg->unsuspend; -&idiot($error) if $error; +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +$error = $cust_pkg->unsuspend; +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Error unsuspending package</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Error unsuspending package</H1> - </CENTER> - <HR> - There has been an error unsuspending this package: $error - </BODY> - </HEAD> -</HTML> -END - exit; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/search/cust_bill.cgi b/htdocs/search/cust_bill.cgi index 5be84b79e..c849341e3 100755 --- a/htdocs/search/cust_bill.cgi +++ b/htdocs/search/cust_bill.cgi @@ -1,46 +1,44 @@ #!/usr/bin/perl -Tw # -# cust_bill.cgi: Search for invoices (process form) +# $Id: cust_bill.cgi,v 1.4 1999-02-28 00:03:54 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_bill.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 97-apr-4 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_bill.cgi,v $ +# Revision 1.4 1999-02-28 00:03:54 ivan +# removed misleading comments +# +# Revision 1.3 1999/01/19 05:14:11 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 09:41:07 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi $invnum ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl idiot); use FS::Record qw(qsearchs); -my($req)=new CGI::Request; -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/; -my($invnum)=$2; +$cgi->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/; +$invnum = $2; if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) { - $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect + print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect } else { #error - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Invoice Search Error</TITLE> - </HEAD> - <BODY> - <CENTER> - <H3>Invoice Search Error</H3> - <HR> - Invoice not found. - </CENTER> - </BODY> -</HTML> -END - + idiot("Invoice not found."); } diff --git a/htdocs/search/cust_main-payinfo.html b/htdocs/search/cust_main-payinfo.html index 92341ad13..47bb83cbd 100755 --- a/htdocs/search/cust_main-payinfo.html +++ b/htdocs/search/cust_main-payinfo.html @@ -2,11 +2,11 @@ <HEAD> <TITLE>Customer Search</TITLE> </HEAD> - <BODY> - <CENTER> - <H1>Customer Search</H1> - </CENTER> - <HR> + <BODY BGCOLOR="#ffffff"> + <FONT COLOR="#ff0000" SIZE=7> + Customer Search + </FONT> + <BR> <FORM ACTION="cust_main.cgi" METHOD="post"> Search for <B>Credit card #</B>: <INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE"> @@ -15,7 +15,6 @@ <P><INPUT TYPE="submit" VALUE="Search"> </FORM> - <HR> </BODY> </HTML> diff --git a/htdocs/search/cust_main.cgi b/htdocs/search/cust_main.cgi index 70ce991f7..099b3c0e8 100755 --- a/htdocs/search/cust_main.cgi +++ b/htdocs/search/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_main.cgi: Search for customers (process form) +# $Id: cust_main.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_main.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-dec-12 # # rewrite ivan@sisd.com 98-mar-4 @@ -17,64 +15,100 @@ # bmccane@maxbaud.net 98-apr-3 # # display total, use FS::CGI ivan@sisd.com 98-jul-17 +# +# $Log: cust_main.cgi,v $ +# Revision 1.11 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.10 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.9 1999/02/28 00:03:55 ivan +# removed misleading comments +# +# 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 +# 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:37 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 00:57:50 ivan +# bug +# +# Revision 1.3 1998/12/17 09:41:08 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/11/12 08:10:22 ivan +# CGI.pm instead of CGI-modules +# relative URLs using popurl +# got rid of lots of little tables +# s/agrep/String::Approx/; +# bubble up packages and services and link (slow) +# use strict; -use CGI::Request; +use vars qw(%ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use IO::Handle; -use IPC::Open2; +use String::Approx qw(amatch); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); - -my($fuzziness)=2; #fuzziness for fuzzy searches, see man agrep - #0-4: 0=no fuzz, 4=very fuzzy (too much fuzz!) - -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); - -my(@cust_main); -my($sortby); - -my($query)=$req->cgi->var('QUERY_STRING'); -if ( $query eq 'custnum' ) { - $sortby=\*custnum_sort; - @cust_main=qsearch('cust_main',{}); -} elsif ( $query eq 'last' ) { - $sortby=\*last_sort; - @cust_main=qsearch('cust_main',{}); -} elsif ( $query eq 'company' ) { - $sortby=\*company_sort; - @cust_main=qsearch('cust_main',{}); +use FS::CGI qw(header menubar eidiot popurl table); +use FS::cust_main; + +$cgi = new CGI; +cgisuidsetup($cgi); + +if ( $cgi->keywords ) { + my($query)=$cgi->keywords; + if ( $query eq 'custnum' ) { + $sortby=\*custnum_sort; + @cust_main=qsearch('cust_main',{}); + } elsif ( $query eq 'last' ) { + $sortby=\*last_sort; + @cust_main=qsearch('cust_main',{}); + } elsif ( $query eq 'company' ) { + $sortby=\*company_sort; + @cust_main=qsearch('cust_main',{}); + } } else { - &cardsearch if ($req->param('card_on') ); - &lastsearch if ($req->param('last_on') ); - &companysearch if ($req->param('company_on') ); + &cardsearch if ( $cgi->param('card_on') && $cgi->param('card') ); + &lastsearch if ( $cgi->param('last_on') && $cgi->param('last_text') ); + &companysearch if ( $cgi->param('company_on') && $cgi->param('company_text') ); } +#%ncancelled_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main; +%all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main; + if ( scalar(@cust_main) == 1 ) { - $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum); + 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); - CGI::Base::SendHeaders(); # one guess - print header("Customer Search Results",''), <<END; - - $total matching customers found - <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> + print $cgi->header( '-expires' => 'now' ), header("Customer Search Results",menubar( + 'Main Menu', popurl(2) + )), "$total matching customers found<BR>", &table(), <<END; <TR> - <TH>Cust. #</TH> + <TH></TH> <TH>Contact name</TH> <TH>Company</TH> + <TH>Packages</TH> + <TH COLSPAN=2>Services</TH> </TR> END - my($lines)=16; - my($lcount)=$lines; my(%saw,$cust_main); foreach $cust_main ( sort $sortby grep(!$saw{$_->custnum}++, @cust_main) @@ -85,30 +119,52 @@ END $cust_main->getfield('first'), $cust_main->company, ); + + my(@lol_cust_svc); + my($rowspan)=0;#scalar( @{$all_pkgs{$custnum}} ); + foreach ( @{$all_pkgs{$custnum}} ) { + my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } ); + push @lol_cust_svc, \@cust_svc; + $rowspan += scalar(@cust_svc) || 1; + } + + #my($rowspan) = scalar(@{$all_pkgs{$custnum}}); + my($view) = popurl(2). "view/cust_main.cgi?$custnum"; print <<END; <TR> - <TD><A HREF="../view/cust_main.cgi?$custnum"><FONT SIZE=-1>$custnum</FONT></A></TD> - <TD><FONT SIZE=-1>$last, $first</FONT></TD> - <TD><FONT SIZE=-1>$company</FONT></TD> - </TR> -END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print <<END; - </TABLE> - <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> - <TR> - <TH>Cust. #</TH> - <TH>Contact name</TH> - <TH>Company<TH> - </TR> + <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$custnum</FONT></A></TD> + <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$last, $first</FONT></A></TD> + <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$company</FONT></A></TD> END + + my($n1)=''; + foreach ( @{$all_pkgs{$custnum}} ) { + my($pkgnum) = ($_->pkgnum); + my($pkg) = $_->part_pkg->pkg; + my $comment = $_->part_pkg->comment; + my($pkgview) = popurl(2). "/view/cust_pkg.cgi?$pkgnum"; + #my(@cust_svc) = shift @lol_cust_svc; + my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } ); + my($rowspan) = scalar(@cust_svc) || 1; + + print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview"><FONT SIZE=-1>$pkg - $comment</FONT></A></TD>!; + my($n2)=''; + foreach my $cust_svc ( @cust_svc ) { + my($label, $value, $svcdb) = $cust_svc->label; + my($svcnum) = $cust_svc->svcnum; + my($sview) = popurl(2). "/view"; + print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!, + qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!; + $n2="</TR><TR>"; + } + #print qq!</TR><TR>\n!; + $n1="</TR><TR>"; } + print "<\TR>"; } print <<END; </TABLE> - </CENTER> </BODY> </HTML> END @@ -122,6 +178,8 @@ sub last_sort { } sub company_sort { + return -1 if $a->company && ! $b->company; + return 1 if ! $a->company && $b->company; $a->getfield('company') cmp $b->getfield('company'); } @@ -131,9 +189,9 @@ sub custnum_sort { sub cardsearch { - my($card)=$req->param('card'); + 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'}); @@ -142,12 +200,12 @@ sub cardsearch { sub lastsearch { my(%last_type); - foreach ( $req->param('last_type') ) { + foreach ( $cgi->param('last_type') ) { $last_type{$_}++; } - $req->param('last_text') =~ /^([\w \,\.\-\']*)$/ - or do { idiot "Illegal last name"; exit; }; + $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/ + or eidiot "Illegal last name"; my($last)=$1; if ( $last_type{'Exact'} @@ -163,16 +221,9 @@ sub lastsearch { my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{}); if ($last_type{'Fuzzy'}) { - my($reader,$writer) = ( new IO::Handle, new IO::Handle ); - open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k', - substr($last,0,30)); - print $writer join("\n",@all_last),"\n"; - close $writer; - while (<$reader>) { - chop; - $last{$_}++; - } - close $reader; + foreach ( amatch($last, [ qw(i) ], @all_last) ) { + $last{$_}++; + } } #if ($last_type{'Sound-alike'}) { @@ -189,12 +240,12 @@ sub lastsearch { sub companysearch { my(%company_type); - foreach ( $req->param('company_type') ) { + foreach ( $cgi->param('company_type') ) { $company_type{$_}++ }; - $req->param('company_text') =~ /^([\w \,\.\-\']*)$/ - or do { idiot "Illegal company"; exit; }; + $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/ + or eidiot "Illegal company"; my($company)=$1; if ( $company_type{'Exact'} @@ -210,16 +261,9 @@ sub companysearch { my(@all_company)=map $_->company, qsearch('cust_main',{}); if ($company_type{'Fuzzy'}) { - my($reader,$writer) = ( new IO::Handle, new IO::Handle ); - open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k', - substr($company,0,30)); - print $writer join("\n",@all_company),"\n"; - close $writer; - while (<$reader>) { - chop; + foreach ( amatch($company, [ qw(i) ], @all_company ) ) { $company{$_}++; } - close $reader; } #if ($company_type{'Sound-alike'}) { diff --git a/htdocs/search/cust_main.html b/htdocs/search/cust_main.html index 656943f9c..3184698b4 100755 --- a/htdocs/search/cust_main.html +++ b/htdocs/search/cust_main.html @@ -2,22 +2,22 @@ <HEAD> <TITLE>Customer Search</TITLE> </HEAD> - <BODY> - <CENTER> - <H1>Customer Search</H1> - </CENTER> - <HR> + <BODY BGCOLOR="#ffffff"> + <FONT COLOR="#ff0000" SIZE=7> + Customer Search + </FONT> + <BR> <FORM ACTION="cust_main.cgi" METHOD="post"> - <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>: + <INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>: <INPUT TYPE="text" NAME="last_text"> - using search method(s): <SELECT NAME="last_type" MULTIPLE> + using search method: <SELECT NAME="last_type"> <OPTION SELECTED>Fuzzy <OPTION>Exact </SELECT> - <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>: + <P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>: <INPUT TYPE="text" NAME="company_text"> - using search methods(s): <SELECT NAME="company_type" MULTIPLE> + using search methods: <SELECT NAME="company_type"> <OPTION SELECTED>Fuzzy <OPTION>Exact </SELECT> diff --git a/htdocs/search/cust_pkg.cgi b/htdocs/search/cust_pkg.cgi index 967068f5e..c48a3c703 100755 --- a/htdocs/search/cust_pkg.cgi +++ b/htdocs/search/cust_pkg.cgi @@ -1,22 +1,50 @@ #!/usr/bin/perl -Tw # -# cust_pkg.cgi: search/browse for packages +# $Id: cust_pkg.cgi,v 1.8 1999-02-09 09:22:57 ivan Exp $ # # based on search/svc_acct.cgi ivan@sisd.com 98-jul-17 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.8 1999-02-09 09:22:57 ivan +# visual and bugfixes +# +# 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/; +# +# Revision 1.5 1999/01/18 09:41:38 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1999/01/18 09:22:33 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.3 1998/12/23 03:05:59 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:41:09 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi @cust_pkg $sortby $query ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); - -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +use FS::CGI qw(header eidiot popurl); +use FS::cust_pkg; +use FS::pkg_svc; +use FS::cust_svc; +use FS::cust_main; -my(@cust_pkg,$sortby); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($query)=$req->cgi->var('QUERY_STRING'); +($query) = $cgi->keywords; #this tree is a little bit redundant if ( $query eq 'pkgnum' ) { $sortby=\*pkgnum_sort; @@ -50,27 +78,23 @@ if ( $query eq 'pkgnum' ) { if ( scalar(@cust_pkg) == 1 ) { my($pkgnum)=$cust_pkg[0]->pkgnum; - $req->cgi->redirect("../view/cust_pkg.cgi?$pkgnum"); + 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); - CGI::Base::SendHeaders(); # one guess - print header('Package Search Results',''), <<END; + print $cgi->header( '-expires' => 'now' ), header('Package Search Results',''), <<END; $total matching packages found <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> <TR> <TH>Package #</TH> <TH>Customer #</TH> - <TH>Name</TH> + <TH>Contact name</TH> <TH>Company</TH> </TR> END - my($lines)=16; - my($lcount)=$lines; my(%saw,$cust_pkg); foreach $cust_pkg ( sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg) @@ -82,33 +106,20 @@ END $cust_main->last. ', '. $cust_main->first, $cust_main->company, ); + my $p = popurl(2); print <<END; <TR> - <TD><A HREF="../view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD> - <TD><FONT SIZE=-1>$custnum</FONT></TD> - <TD><FONT SIZE=-1>$name</FONT></TD> - <TD><FONT SIZE=-1>$company</FONT></TD> + <TD><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD> + <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$custnum</A></FONT></TD> + <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$name</A></FONT></TD> + <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$company</A></FONT></TD> </TR> END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print <<END; - </TABLE> - <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> - <TR> - <TH>Package #</TH> - <TH>Customer #</TH> - <TH>Name</TH> - <TH>Company</TH> - <TH> - </TR> -END - } + } print <<END; </TABLE> - </CENTER> </BODY> </HTML> END diff --git a/htdocs/search/svc_acct.cgi b/htdocs/search/svc_acct.cgi index 250a741db..96ddf957a 100755 --- a/htdocs/search/svc_acct.cgi +++ b/htdocs/search/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct.cgi: Search for customers (process form) +# $Id: svc_acct.cgi,v 1.9 1999-04-10 01:53:18 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi @@ -21,20 +21,50 @@ # use FS::CGI, show total ivan@sisd.com 98-jul-17 # # give service and customer info too ivan@sisd.com 98-aug-16 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.9 1999-04-10 01:53:18 ivan +# oops, search usernames limited to 8 chars +# +# Revision 1.8 1999/04/09 23:43:29 ivan +# just in case +# +# 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/; +# +# Revision 1.5 1999/01/18 09:41:39 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1999/01/18 09:22:34 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.3 1998/12/23 03:06:28 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:41:10 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; # form processing module +use vars qw( $cgi @svc_acct $sortby $query ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); +use FS::CGI qw(header eidiot popurl); +use FS::svc_acct; +use FS::cust_main; -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my(@svc_acct,$sortby); - -my($query)=$req->cgi->var('QUERY_STRING'); +($query)=$cgi->keywords; +$query ||= ''; #to avoid use of unitialized value errors #this tree is a little bit redundant if ( $query eq 'svcnum' ) { $sortby=\*svcnum_sort; @@ -64,20 +94,19 @@ if ( $query eq 'svcnum' ) { 'pkgnum' => '', }), qsearch('svc_acct',{}); } else { + $sortby=\*uid_sort; &usernamesearch; } if ( scalar(@svc_acct) == 1 ) { my($svcnum)=$svc_acct[0]->svcnum; - $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect + 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); - CGI::Base::SendHeaders(); # one guess - print header("Account Search Results",''), <<END; + print $cgi->header( '-expires' => 'now' ), header("Account Search Results",''), <<END; $total matching accounts found <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> <TR> @@ -91,9 +120,8 @@ if ( scalar(@svc_acct) == 1 ) { </TR> END - my($lines)=16; - my($lcount)=$lines; my(%saw,$svc_acct); + my $p = popurl(2); foreach $svc_acct ( sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct) ) { @@ -119,37 +147,23 @@ END $cust_svc->pkgnum ? $cust_main->company : '', ); my($pcustnum) = $custnum - ? "<A HREF=\"../view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>" + ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>" : "<I>(unlinked)</I>" ; - my($pname) = $custnum ? "$last, $first" : ''; + my($pname) = $custnum ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\">$last, $first</A>" : ''; + my $pcompany = $custnum ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\">$company</A>" : ''; print <<END; <TR> - <TD><A HREF="../view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD> + <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD> <TD><FONT SIZE=-1>$username</FONT></TD> <TD><FONT SIZE=-1>$uid</FONT></TD> <TD><FONT SIZE=-1>$svc</FONT></TH> <TD><FONT SIZE=-1>$pcustnum</FONT></TH> <TD><FONT SIZE=-1>$pname<FONT></TH> - <TD><FONT SIZE=-1>$company</FONT></TH> - </TR> -END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print <<END; - </TABLE> - <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> - <TR> - <TH>Service #</TH> - <TH>Userame</TH> - <TH>UID</TH> - <TH>Service</TH> - <TH>Customer #</TH> - <TH>Contact name</TH> - <TH>Company</TH> + <TD><FONT SIZE=-1>$pcompany</FONT></TH> </TR> END - } + } print <<END; @@ -176,7 +190,7 @@ sub uid_sort { sub usernamesearch { - $req->param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text + $cgi->param('username') =~ /^([\w\d\-]+)$/; #untaint username_text my($username)=$1; @svc_acct=qsearch('svc_acct',{'username'=>$username}); diff --git a/htdocs/search/svc_acct_sm.cgi b/htdocs/search/svc_acct_sm.cgi index 3b1a4cf4e..e92a15ebb 100755 --- a/htdocs/search/svc_acct_sm.cgi +++ b/htdocs/search/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_acct_sm.cgi: Search for domains (process form) +# $Id: svc_acct_sm.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-mar-5 # # need to look at table in results to make it more readable @@ -17,33 +15,58 @@ # # 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.9 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.8 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.7 1999/02/28 00:03:56 ivan +# removed misleading comments +# +# Revision 1.6 1999/02/09 09:22:58 ivan +# visual and bugfixes +# +# Revision 1.5 1999/01/19 05:14:16 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:40 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 09:41:11 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; +use vars qw( $conf $cgi $mydomain $domuser $svc_domain $domsvc @svc_acct_sm ); use CGI::Request; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl idiot header table); use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::svc_domain; +use FS::svc_acct_sm; +use FS::svc_acct; -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1 -} grep $_ !~ /^(#|$)/, <DOMAIN>; -close DOMAIN; +$cgi = new CGI; +&cgisuidsetup($cgi); -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); -$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/; -my($domuser)=$1; +$cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/; +$domuser = $1; -$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain"; -my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1}) +$cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain"; +$svc_domain = qsearchs('svc_domain',{'domain'=>$1}) or die "Unknown domain"; -my($domsvc)=$svc_domain->svcnum; +$domsvc = $svc_domain->svcnum; -my(@svc_acct_sm); if ($domuser) { @svc_acct_sm=qsearch('svc_acct_sm',{ 'domuser' => $domuser, @@ -55,21 +78,14 @@ if ($domuser) { if ( scalar(@svc_acct_sm) == 1 ) { my($svcnum)=$svc_acct_sm[0]->svcnum; - $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect + print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum"); } elsif ( scalar(@svc_acct_sm) > 1 ) { - CGI::Base::SendHeaders(); - print <<END; -<HTML> - <HEAD> - <TITLE>Mail Alias Search Results</TITLE> - </HEAD> - <BODY> - <CENTER> - <H4>Mail Alias Search Results</H4> - <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> + print $cgi->header( '-expires' => 'now' ), + header('Mail Alias Search Results'), + &table(), <<END; <TR> - <TH>Mail to<BR><FONT SIZE=-2>(click here to view mail alias)</FONT></TH> - <TH>Forwards to<BR><FONT SIZE=-2>(click here to view account)</FONT></TH> + <TH>Mail to<BR><FONT SIZE=-1>(click to view mail alias)</FONT></TH> + <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH> </TR> END @@ -81,48 +97,41 @@ END $svc_acct_sm->domuid, $svc_acct_sm->domsvc, ); - my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc}); - my($domain)=$svc_domain->domain; - my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid}); - my($username)=$svc_acct->username; - my($svc_acct_svcnum)=$svc_acct->svcnum; - - print <<END; -<TR>\n <TD> <A HREF="../view/svc_acct_sm.cgi?$svcnum"> -END - - print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ); - print <<END; -\@$domain</A> </TD>\n -<TD> <A HREF="../view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A> </TD>\n </TR>\n -END + my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } ); + if ( $svc_domain ) { + my $domain = $svc_domain->domain; + + print qq!<TR><TD><A HREF="!. popurl(2). qq!view/svc_acct_sm.cgi?$svcnum">!, + #print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ); + ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ), + qq!\@$domain</A> </TD>!, + ; + } else { + my $warning = "couldn't find svc_domain.svcnum $svcnum ( svc_acct_sm.svcnum $svcnum"; + warn $warning; + print "<TR><TD>WARNING: $warning</TD>"; + } + + my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $domuid } ); + if ( $svc_acct ) { + my $username = $svc_acct->username; + my $svc_acct_svcnum =$svc_acct->svcnum; + print qq!<TD><A HREF="!, popurl(2), + qq!view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A>!, + qq!</TD></TR>! + ; + } else { + my $warning = "couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum $svcnum)!"; + warn $warning; + print "<TD>WARNING: $warning</TD></TR>"; + } } - print <<END; - </TABLE> - </CENTER> - </BODY> -</HTML> -END + print '</TABLE></BODY></HTML>'; } else { #error - CGI::Base::SendHeaders(); # one guess - print <<END; -<HTML> - <HEAD> - <TITLE>Mail Alias Search Error</TITLE> - </HEAD> - <BODY> - <CENTER> - <H3>Mail Alias Search Error</H3> - <HR> - Mail Alias not found. - </CENTER> - </BODY> -</HTML> -END - + idiot("Mail Alias not found"); } diff --git a/htdocs/search/svc_domain.cgi b/htdocs/search/svc_domain.cgi index d5277037b..b366e5724 100755 --- a/htdocs/search/svc_domain.cgi +++ b/htdocs/search/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_domain.cgi: Search for domains (process form) +# $Id: svc_domain.cgi,v 1.8 1999-02-28 00:03:57 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 97-mar-5 # # rewrite ivan@sisd.com 98-mar-14 @@ -15,21 +13,50 @@ # bmccane@maxbaud.net 98-apr-3 # # display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.8 1999-02-28 00:03:57 ivan +# removed misleading comments +# +# Revision 1.7 1999/02/23 08:09:24 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.6 1999/02/09 09:22:59 ivan +# visual and bugfixes +# +# 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/; +# +# Revision 1.3 1998/12/23 03:06:50 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:41:12 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi @svc_domain $sortby $query $conf $mydomain ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); +use FS::CGI qw(header eidiot popurl); +use FS::svc_domain; +use FS::cust_svc; +use FS::svc_acct_sm; +use FS::svc_acct; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my(@svc_domain); -my($sortby); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); -my($query)=$req->cgi->var('QUERY_STRING'); +($query)=$cgi->keywords; if ( $query eq 'svcnum' ) { $sortby=\*svcnum_sort; @svc_domain=qsearch('svc_domain',{}); @@ -49,36 +76,33 @@ if ( $query eq 'svcnum' ) { 'pkgnum' => '', }), qsearch('svc_domain',{}); } else { - $req->param('domain') =~ /^([\w\-\.]+)$/; + $cgi->param('domain') =~ /^([\w\-\.]+)$/; my($domain)=$1; push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain}); } if ( scalar(@svc_domain) == 1 ) { - $req->cgi->redirect("../view/svc_domain.cgi?". $svc_domain[0]->svcnum); + 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 my($total)=scalar(@svc_domain); - CGI::Base::SendHeaders(); # one guess - print header("Domain Search Results",''), <<END; + print $cgi->header, header("Domain Search Results",''), <<END; $total matching domains found <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> <TR> <TH>Service #</TH> <TH>Domain</TH> - <TH></TH> + <TH>Mail to<BR><FONT SIZE=-1>(click to view mail alias)</FONT></TH> + <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH> </TR> END - my($lines)=16; - my($lcount)=$lines; my(%saw,$svc_domain); + my $p = popurl(2); foreach $svc_domain ( sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain) ) { @@ -86,42 +110,76 @@ END $svc_domain->svcnum, $svc_domain->domain, ); - my($malias); - if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) { - $malias=( - qq|<FORM ACTION="svc_acct_sm.cgi" METHOD="post">|. - qq|<INPUT TYPE="hidden" NAME="domuser" VALUE="">|. - qq|<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">|. - qq|<INPUT TYPE="submit" VALUE="(mail aliases)">|. - qq|</FORM>| - ); - } else { - $malias=''; - } + #my($malias); + #if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) { + # $malias=( + # qq|<FORM ACTION="svc_acct_sm.cgi" METHOD="post">|. + # qq|<INPUT TYPE="hidden" NAME="domuser" VALUE="">|. + # qq|<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">|. + # qq|<INPUT TYPE="submit" VALUE="(mail aliases)">|. + # qq|</FORM>| + # ); + #} else { + # $malias=''; + #} + + my @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $svcnum}); + my $rowspan = scalar(@svc_acct_sm) || 1; + print <<END; <TR> - <TD><A HREF="../view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD> - <TD><FONT SIZE=-1>$domain</FONT></TD> - <TD><FONT SIZE=-1>$malias</FONT></TD> - </TR> -END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print <<END; - </TABLE> - <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0> - <TR> - <TH>Service #</TH> - <TH>Domain</TH> - <TH></TH> - </TR> + <TD ROWSPAN=$rowspan><A HREF="${p}view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD> + <TD ROWSPAN=$rowspan>$domain</TD> END + + my $n1 = ''; + # false laziness: this was stolen from search/svc_acct_sm.cgi. but the + # web interface in general needs to be rewritten in a mucho cleaner way + my($svc_acct_sm); + foreach $svc_acct_sm (@svc_acct_sm) { + my($svcnum,$domuser,$domuid,$domsvc)=( + $svc_acct_sm->svcnum, + $svc_acct_sm->domuser, + $svc_acct_sm->domuid, + $svc_acct_sm->domsvc, + ); + #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } ); + #if ( $svc_domain ) { + # my $domain = $svc_domain->domain; + + print qq!$n1<TD><A HREF="!. popurl(2). qq!view/svc_acct_sm.cgi?$svcnum">!, + #print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ); + ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ), + qq!\@$domain</A> </TD>!, + ; + #} else { + # my $warning = "couldn't find svc_domain.svcnum $svcnum ( svc_acct_sm.svcnum $svcnum"; + # warn $warning; + # print "$n1<TD>WARNING: $warning</TD>"; + #} + + my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $domuid } ); + if ( $svc_acct ) { + my $username = $svc_acct->username; + my $svc_acct_svcnum =$svc_acct->svcnum; + print qq!<TD><A HREF="!, popurl(2), + qq!view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A>!, + qq!</TD></TR>! + ; + } else { + my $warning = "couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum $svcnum)!"; + warn $warning; + print "<TD>WARNING: $warning</TD>"; + } + $n1 = "</TR><TR>"; } + #end of false laziness + print "</TR>"; + } print <<END; </TABLE> - </CENTER> </BODY> </HTML> END diff --git a/htdocs/view/cust_bill.cgi b/htdocs/view/cust_bill.cgi index 96101d004..93a6f7a29 100755 --- a/htdocs/view/cust_bill.cgi +++ b/htdocs/view/cust_bill.cgi @@ -1,9 +1,6 @@ #!/usr/bin/perl -Tw # -# Usage: cust_bill.cgi invnum -# http://server.name/path/cust_bill.cgi?invnum -# -# Note: Should be run setuid freeside as user nobody. +# $Id: cust_bill.cgi,v 1.8 1999-02-28 00:03:58 ivan Exp $ # # this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice # @@ -24,50 +21,67 @@ # bmccane@maxbaud.net 98-apr-3 # # also print 'printed' field ivan@sisd.com 98-jul-10 +# +# $Log: cust_bill.cgi,v $ +# Revision 1.8 1999-02-28 00:03:58 ivan +# removed misleading comments +# +# Revision 1.7 1999/01/25 12:26:03 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:14:18 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:42 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 23:03:33 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/23 03:07:49 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:57:20 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; +use vars qw ( $cgi $query $invnum $cust_bill $custnum $printed $p ); use IO::File; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl menubar); use FS::Record qw(qsearchs); -use FS::Invoice; +use FS::cust_bill; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint invnum -$QUERY_STRING =~ /^(\d+)$/; -my($invnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$invnum = $1; -my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum}); +$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum}); die "Invoice #$invnum not found!" unless $cust_bill; -my($custnum) = $cust_bill->getfield('custnum'); +$custnum = $cust_bill->getfield('custnum'); -my($printed) = $cust_bill->printed; +$printed = $cust_bill->printed; -SendHeaders(); # one guess. -print <<END; -<HTML> - <HEAD> - <TITLE>Invoice View</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Invoice View</H1> - <A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | <A HREF="../">Main menu</A> - </CENTER><HR> - <BASEFONT SIZE=3> - <CENTER> - <A HREF="../edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A> - <BR><A HREF="../misc/print-invoice.cgi?$invnum">Reprint this invoice</A> +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Invoice View', menubar( + "Main Menu" => $p, + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", +)), <<END; + <A HREF="${p}edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A> + <BR><A HREF="${p}misc/print-invoice.cgi?$invnum">Reprint this invoice</A> <BR><BR>(Printed $printed times) - </CENTER> - <FONT SIZE=-1><PRE> + <PRE> END -bless($cust_bill,"FS::Invoice"); print $cust_bill->print_text; #formatting diff --git a/htdocs/view/cust_main.cgi b/htdocs/view/cust_main.cgi index ca5fcd94f..6f6c33540 100755 --- a/htdocs/view/cust_main.cgi +++ b/htdocs/view/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_main.cgi: View a customer +# $Id: cust_main.cgi,v 1.16 1999-04-09 04:22:34 ivan Exp $ # # Usage: cust_main.cgi custnum # http://server.name/path/cust_main.cgi?custnum # -# Note: Should be run setuid freeside as user nobody. -# # the payment history section could use some work, see below # # ivan@voicenet.com 96-nov-29 -> 96-dec-11 @@ -31,147 +29,218 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main.cgi,v $ +# Revision 1.16 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.15 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.14 1999/04/08 04:04:37 ivan +# eliminate double // in links +# +# Revision 1.13 1999/02/28 00:04:00 ivan +# removed misleading comments +# +# 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 +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.9 1999/01/18 09:41:43 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.8 1999/01/18 09:22:35 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.7 1998/12/30 23:03:34 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.6 1998/12/23 02:42:33 ivan +# remove double '/' in link urls +# +# Revision 1.5 1998/12/23 02:36:28 ivan +# use FS::cust_refund; to eliminate warning +# +# Revision 1.4 1998/12/17 09:57:21 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.3 1998/11/15 13:14:20 ivan +# first pass as per-customer custom pricing +# +# Revision 1.2 1998/11/13 11:28:08 ivan +# s/CGI-modules/CGI.pm/;, relative URL's with popurl +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral + @packages $package @history @bills $bill @credits $credit + $balance $item @agents @referrals @invoicing_list $n1 ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use Date::Format; use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs qsearch); -use FS::CGI qw(header menubar); - -my($cgi) = new CGI::Base; -$cgi->get; +use FS::CGI qw(header menubar popurl table itable ntable); +use FS::cust_credit; +use FS::cust_pay; +use FS::cust_bill; +use FS::part_pkg; +use FS::cust_pkg; +use FS::part_referral; +use FS::agent; +use FS::cust_main; +use FS::cust_refund; + +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header("Customer View", menubar( - 'Main Menu' => '../', -)),<<END; - <BASEFONT SIZE=3> -END +print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar( + 'Main Menu' => popurl(2) +)); -#untaint custnum & get customer record -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; -my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); +die "No customer specified (bad URL)!" unless $cgi->keywords; +($query) = $cgi->keywords; # needs parens with my, ->keywords returns array +$query =~ /^(\d+)$/; +$custnum = $1; +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); die "Customer not found!" unless $cust_main; -my($hashref)=$cust_main->hashref; +$hashref = $cust_main->hashref; -#custnum -print "<FONT SIZE=+1><CENTER>Customer #<B>$custnum</B></CENTER></FONT>", - qq!<CENTER><A HREF="#cust_main">Customer Information</A> | !, - qq!<A HREF="#cust_comments">Comments</A> | !, - qq!<A HREF="#cust_pkg">Packages</A> | !, - qq!<A HREF="#history">Payment History</A> </CENTER>!; +print &itable(), '<TR><TD><A NAME="cust_main"></A>'; -#bill now linke -print qq!<HR><CENTER><A HREF="../misc/bill.cgi?$custnum">!, - qq!Bill this customer now</A></CENTER>!; +print qq!<A HREF="!, popurl(2), + qq!edit/cust_main.cgi?$custnum">Edit this customer</A>!, + &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2), + '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">', + $custnum, '</TD></TR>', +; -#formatting -print qq!<HR><A NAME="cust_main"><CENTER><FONT SIZE=+1>Customer Information!, - qq!</FONT>!, - qq!<BR><A HREF="../edit/cust_main.cgi?$custnum!, - qq!">Edit this information</A></CENTER><FONT SIZE=-1>!; - -#agentnum -my($agent)=qsearchs('agent',{ - 'agentnum' => $cust_main->getfield('agentnum') -} ); -die "Agent not found!" unless $agent; -print "<BR>Agent #<B>" , $agent->getfield('agentnum') , ": " , - $agent->getfield('agent') , "</B>"; - -#refnum -my($referral)=qsearchs('part_referral',{'refnum' => $cust_main->refnum}); -die "Referral not found!" unless $referral; -print "<BR>Referral #<B>", $referral->refnum, ": ", - $referral->referral, "<\B>"; - -#last, first -print "<P><B>", $hashref->{'last'}, ", ", $hashref->{first}, "</B>"; - -#ss -print " (SS# <B>", $hashref->{ss}, "</B>)" if $hashref->{ss}; - -#company -print "<BR><B>", $hashref->{company}, "</B>" if $hashref->{company}; - -#address1 -print "<BR><B>", $hashref->{address1}, "</B>"; - -#address2 -print "<BR><B>", $hashref->{address2}, "</B>" if $hashref->{address2}; - -#city -print "<BR><B>", $hashref->{city}, "</B>"; - -#county -print " (<B>", $hashref->{county}, "</B> county)" if $hashref->{county}; - -#state -print ",<B>", $hashref->{state}, "</B>"; - -#zip -print " <B>", $hashref->{zip}, "</B>"; - -#country -print "<BR><B>", $hashref->{country}, "</B>" - unless $hashref->{country} eq "US"; - -#daytime -print "<P><B>", $hashref->{daytime}, "</B>" if $hashref->{daytime}; -print " (Day)" if $hashref->{daytime} && $hashref->{night}; - -#night -print "<BR><B>", $hashref->{night}, "</B>" if $hashref->{night}; -print " (Night)" if $hashref->{daytime} && $hashref->{night}; - -#fax -print "<BR><B>", $hashref->{fax}, "</B> (Fax)" if $hashref->{fax}; - -#payby/payinfo/paydate/payname -if ($hashref->{payby} eq "CARD") { - print "<P>Card #<B>", $hashref->{payinfo}, "</B> Exp. <B>", - $hashref->{paydate}, "</B>"; - print " (<B>", $hashref->{payname}, "</B>)" if $hashref->{payname}; -} elsif ($hashref->{payby} eq "BILL") { - print "<P>Bill"; - print " on P.O. #<B>", $hashref->{payinfo}, "</B>" - if $hashref->{payinfo}; - print " until <B>", $hashref->{paydate}, "</B>" - if $hashref->{paydate}; - print " to <B>", $hashref->{payname}, "</B> at above address" - if $hashref->{payname}; -} elsif ($hashref->{payby} eq "COMP") { - print "<P>Access complimentary"; - print " courtesy of <B>", $hashref->{payinfo}, "</B>" - if $hashref->{payinfo}; - print " until <B>", $hashref->{paydate}, "</B>" - if $hashref->{paydate}; -} else { - print "Unknown payment type ", $hashref->{payby}, "!"; +@agents = qsearch( 'agent', {} ); +unless ( scalar(@agents) == 1 ) { + $agent = qsearchs('agent',{ + 'agentnum' => $cust_main->agentnum + } ); + print '<TR><TD ALIGN="right">Agent</TD><TD BGCOLOR="#ffffff">', + $agent->agentnum, ": ", $agent->agent, '</TD></TR>'; +} +@referrals = qsearch( 'part_referral', {} ); +unless ( scalar(@referrals) == 1 ) { + my $referral = qsearchs('part_referral', { + 'refnum' => $cust_main->refnum + } ); + print '<TR><TD ALIGN="right">Referral</TD><TD BGCOLOR="#ffffff">', + $referral->refnum, ": ", $referral->referral, '</TD></TR>'; +} +print '<TR><TD ALIGN="right">Order taker</TD><TD BGCOLOR="#ffffff">', + $cust_main->otaker, '</TD></TR>'; + +print '</TABLE></TD></TR></TABLE>'; + +print '</TD><TD ROWSPAN=2>'; + +print "Contact information", &ntable("#c0c0c0"), "<TR><TD>", + &ntable("#c0c0c0",2), + '<TR><TD ALIGN="right">Contact name<BR>(last, first)</TD>', + '<TD COLSPAN=3 BGCOLOR="#ffffff">', + $cust_main->last, ', ', $cust_main->first, + '</TD><TD ALIGN="right">SS#</TD><TD BGCOLOR="#ffffff">', + $cust_main->ss || ' ', '</TD></TR>', + '<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5 BGCOLOR="#ffffff">', + $cust_main->company, + '</TD></TR>', + '<TR><TD ALIGN="right">Address</TD><TD COLSPAN=5 BGCOLOR="#ffffff">', + $cust_main->address1, + '</TD></TR>', +; +print '<TR><TD ALIGN="right"> </TD><TD COLSPAN=5 BGCOLOR="#ffffff">', + $cust_main->address2, '</TD></TR>' + if $cust_main->address2; +print '<TR><TD ALIGN="right">City</TD><TD BGCOLOR="#ffffff">', + $cust_main->city, + '</TD><TD ALIGN="right">State</TD><TD BGCOLOR="#ffffff">', + $cust_main->state, + '</TD><TD ALIGN="right">Zip</TD><TD BGCOLOR="#ffffff">', + $cust_main->zip, '</TD></TR>', + '<TR><TD ALIGN="right">Country</TD><TD BGCOLOR="#ffffff">', + $cust_main->country, + '</TD></TR>', +; +print '<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5 BGCOLOR="#ffffff">', + $cust_main->daytime || ' ', '</TD></TR>', + '<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5 BGCOLOR="#ffffff">', + $cust_main->night || ' ', '</TD></TR>', + '<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5 BGCOLOR="#ffffff">', + $cust_main->fax || ' ', '</TD></TR>', + '</TABLE>', "</TD></TR></TABLE>" +; + +print '</TD></TR><TR><TD>'; + +@invoicing_list = $cust_main->invoicing_list; +print "Billing information (", + qq!<A HREF="!, popurl(2), qq!/misc/bill.cgi?$custnum">!, "Bill now</A>)", + &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2), + '<TR><TD ALIGN="right">Tax exempt</TD><TD BGCOLOR="#ffffff">', + $cust_main->tax ? 'yes' : 'no', + '</TD></TR>', + '<TR><TD ALIGN="right">Postal invoices</TD><TD BGCOLOR="#ffffff">', + ( 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 ) || 'no', + '</TD></TR>', + '<TR><TD ALIGN="right">Billing type</TD><TD BGCOLOR="#ffffff">', +; + +if ( $cust_main->payby eq 'CARD' ) { + print 'Credit card</TD></TR>', + '<TR><TD ALIGN="right">Card number</TD><TD BGCOLOR="#ffffff">', + $cust_main->payinfo, '</TD></TR>', + '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">', + $cust_main->paydate, '</TD></TR>', + '<TR><TD ALIGN="right">Name on card</TD><TD BGCOLOR="#ffffff">', + $cust_main->payname, '</TD></TR>' + ; +} elsif ( $cust_main->payby eq 'BILL' ) { + print 'Billing</TD></TR>'; + print '<TR><TD ALIGN="right">P.O. </TD><TD BGCOLOR="#ffffff">', + $cust_main->payinfo, '</TD></TR>', + if $cust_main->payinfo; + print '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">', + $cust_main->paydate, '</TD></TR>', + '<TR><TD ALIGN="right">Attention</TD><TD BGCOLOR="#ffffff">', + $cust_main->payname, '</TD></TR>', + ; +} elsif ( $cust_main->payby eq 'COMP' ) { + print 'Complimentary</TD></TR>', + '<TR><TD ALIGN="right">Authorized by</TD><TD BGCOLOR="#ffffff">', + $cust_main->payinfo, '</TD></TR>', + '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">', + $cust_main->paydate, '</TD></TR>', + ; } -#tax -print "<BR>(Tax exempt)" if $hashref->{tax}; - -#otaker -print "<P>Order taken by <B>", $hashref->{otaker}, "</B>"; +print "</TABLE></TD></TR></TABLE></TD></TR></TABLE>"; -#formatting -print qq!<HR><FONT SIZE=+1><A NAME="cust_pkg"><CENTER>Packages</A></FONT>!, - qq!<BR>Click on package number to view/edit package.!, - qq!<BR><A HREF="../edit/cust_pkg.cgi?$custnum">Add/Edit packages</A>!, - qq!</CENTER><BR>!; +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> )!, +; #display packages #formatting -print qq!<CENTER><TABLE BORDER=4>\n!, - qq!<TR><TH ROWSPAN=2>#</TH><TH ROWSPAN=2>Package</TH><TH COLSPAN=5>!, - qq!Dates</TH></TR>\n!, +print qq!!, &table(), "\n", + qq!<TR><TH COLSPAN=2 ROWSPAN=2>Package</TH><TH COLSPAN=5>!, + qq!Dates</TH><TH COLSPAN=2 ROWSPAN=2>Services</TH></TR>\n!, qq!<TR><TH><FONT SIZE=-1>Setup</FONT></TH><TH>!, qq!<FONT SIZE=-1>Next bill</FONT>!, qq!</TH><TH><FONT SIZE=-1>Susp.</FONT></TH><TH><FONT SIZE=-1>Expire!, @@ -180,59 +249,73 @@ print qq!<CENTER><TABLE BORDER=4>\n!, qq!</TR>\n!; #get package info -my(@packages)=qsearch('cust_pkg',{'custnum'=>$custnum}); -my($package); +@packages = $cust_main->all_pkgs; +#@packages = $cust_main->ncancelled_pkgs; + +$n1 = '<TR>'; foreach $package (@packages) { - my($pref)=$package->hashref; - my($part_pkg)=qsearchs('part_pkg',{ - 'pkgpart' => $pref->{pkgpart} - } ); - print qq!<TR><TD><FONT SIZE=-1><A HREF="../view/cust_pkg.cgi?!, - $pref->{pkgnum}, qq!">!, - $pref->{pkgnum}, qq!</A></FONT></TD>!, - "<TD><FONT SIZE=-1>", $part_pkg->getfield('pkg'), " - ", - $part_pkg->getfield('comment'), "</FONT></TD>", - "<TD><FONT SIZE=-1>", - $pref->{setup} ? time2str("%D",$pref->{setup} ) : "" , - "</FONT></TD>", - "<TD><FONT SIZE=-1>", - $pref->{bill} ? time2str("%D",$pref->{bill} ) : "" , - "</FONT></TD>", - "<TD><FONT SIZE=-1>", - $pref->{susp} ? time2str("%D",$pref->{susp} ) : "" , - "</FONT></TD>", - "<TD><FONT SIZE=-1>", - $pref->{expire} ? time2str("%D",$pref->{expire} ) : "" , - "</FONT></TD>", - "<TD><FONT SIZE=-1>", - $pref->{cancel} ? time2str("%D",$pref->{cancel} ) : "" , - "</FONT></TD>", - "</TR>"; -} + my $pkgnum = $package->pkgnum; + my $pkg = $package->part_pkg->pkg; + my $comment = $package->part_pkg->comment; + my $pkgview = popurl(2). "view/cust_pkg.cgi?$pkgnum"; + my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ); + my $rowspan = scalar(@cust_svc) || 1; + + my $button_cgi = new CGI; + $button_cgi->param('clone', $package->part_pkg->pkgpart); + $button_cgi->param('pkgnum', $package->pkgnum); + my $button_url = popurl(2). "edit/part_pkg.cgi?". $button_cgi->query_string; + + #print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview">$pkgnum</A></TD>!, + print $n1, qq!<TD ROWSPAN=$rowspan>$pkgnum</TD>!, + 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>!, + ; + for ( qw( setup bill susp expire cancel ) ) { + print "<TD ROWSPAN=$rowspan><FONT SIZE=-1>", ( $package->getfield($_) + ? time2str("%D", $package->getfield($_) ) + : ' ' + ), '</FONT></TD>', + ; + } + + my $n2 = ''; + foreach my $cust_svc ( @cust_svc ) { + my($label, $value, $svcdb) = $cust_svc->label; + my($svcnum) = $cust_svc->svcnum; + my($sview) = popurl(2). "view"; + print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!, + qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!; + $n2="</TR><TR>"; + } + $n1="</TR><TR>"; +} +print "</TR>"; #formatting -print "</TABLE></CENTER>"; +print "</TABLE>"; #formatting -print qq!<CENTER><HR><A NAME="history"><FONT SIZE=+1>Payment History!, - qq!</FONT></A><BR>!, - qq!Click on invoice to view invoice/enter payment.<BR>!, - qq!<A HREF="../edit/cust_credit.cgi?$custnum">!, - qq!Post Credit / Refund</A></CENTER><BR>!; +print qq!<BR><BR><A NAME="history">Payment History!, + qq!</A>!, + qq! ( Click on invoice to view invoice/enter payment. | !, + qq!<A HREF="!, popurl(2), qq!edit/cust_credit.cgi?$custnum">!, + qq!Post credit / refund</A> )!; #get payment history # # major problem: this whole thing is way too sloppy. # minor problem: the description lines need better formatting. -my(@history); +@history = (); #needed for mod_perl :) -my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum}); -my($bill); +@bills = qsearch('cust_bill',{'custnum'=>$custnum}); foreach $bill (@bills) { my($bref)=$bill->hashref; push @history, - $bref->{_date} . qq!\t<A HREF="../view/cust_bill.cgi?! . + $bref->{_date} . qq!\t<A HREF="!. popurl(2). qq!view/cust_bill.cgi?! . $bref->{invnum} . qq!">Invoice #! . $bref->{invnum} . qq! (Balance \$! . $bref->{owed} . qq!)</A>\t! . $bref->{charged} . qq!\t\t\t!; @@ -240,7 +323,6 @@ foreach $bill (@bills) { my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } ); my($payment); foreach $payment (@payments) { -# my($pref)=$payment->hashref; my($date,$invnum,$payby,$payinfo,$paid)=($payment->getfield('_date'), $payment->getfield('invnum'), $payment->getfield('payby'), @@ -252,8 +334,7 @@ foreach $bill (@bills) { } } -my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum}); -my($credit); +@credits = qsearch('cust_credit',{'custnum'=>$custnum}); foreach $credit (@credits) { my($cref)=$credit->hashref; push @history, @@ -274,8 +355,7 @@ foreach $credit (@credits) { } #formatting - print <<END; -<CENTER><TABLE BORDER=4> + print &table(), <<END; <TR> <TH>Date</TH> <TH>Description</TH> @@ -289,8 +369,7 @@ END #display payment history -my($balance)=0; -my($item); +$balance = 0; foreach $item (sort keyfield_numerically @history) { my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item); $charge ||= 0; @@ -320,7 +399,7 @@ foreach $item (sort keyfield_numerically @history) { } #formatting -print "</TABLE></CENTER>"; +print "</TABLE>"; #end diff --git a/htdocs/view/cust_pkg.cgi b/htdocs/view/cust_pkg.cgi index 04e38326a..0054ee0fa 100755 --- a/htdocs/view/cust_pkg.cgi +++ b/htdocs/view/cust_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_pkg.cgi: View a package +# $Id: cust_pkg.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $ # # Usage: cust_pkg.cgi pkgnum # http://server.name/path/cust_pkg.cgi?pkgnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-dec-15 # # services section needs to be cleaned up, needs to display extraneous @@ -24,118 +22,140 @@ # ivan@voicenet.com 97-jul-29 # # no FS::Search ivan@sisd.com 98-mar-7 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.11 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.10 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.9 1999/04/08 12:00:19 ivan +# aesthetic update +# +# Revision 1.8 1999/02/28 00:04:01 ivan +# removed misleading comments +# +# Revision 1.7 1999/01/19 05:14:20 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:44 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/23 03:11:40 ivan +# *** empty log message *** +# +# Revision 1.3 1998/12/17 09:57:22 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/11/13 09:56:49 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; +use vars qw ( $cgi %uiview %uiadd $part_svc $query $pkgnum $cust_pkg $part_pkg + $custnum $susp $cancel $expire $pkg $comment $setup $bill + $otaker ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl header menubar ntable table); use FS::Record qw(qsearch qsearchs); +use FS::part_svc; +use FS::cust_pkg; +use FS::part_pkg; +use FS::pkg_svc; +use FS::cust_svc; -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -my(%uiview,%uiadd); -my($part_svc); foreach $part_svc ( qsearch('part_svc',{}) ) { - $uiview{$part_svc->svcpart}="../view/". $part_svc->svcdb . ".cgi"; - $uiadd{$part_svc->svcpart}="../edit/". $part_svc->svcdb . ".cgi"; + $uiview{$part_svc->svcpart} = popurl(2). "view/". $part_svc->svcdb . ".cgi"; + $uiadd{$part_svc->svcpart}= popurl(2). "edit/". $part_svc->svcdb . ".cgi"; } -SendHeaders(); # one guess. -print <<END; -<HTML> - <HEAD> - <TITLE>Package View</TITLE> - </HEAD> - <BODY> - <CENTER> - <H1>Package View</H1> - </CENTER> - <BASEFONT SIZE=3> -END - -#untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/; -my($pkgnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$pkgnum = $1; #get package record -my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); die "No package!" unless $cust_pkg; -my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')}); +$part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')}); -#nav bar -my($custnum)=$cust_pkg->getfield('custnum'); -print qq!<CENTER><A HREF="../view/cust_main.cgi?$custnum">View this customer!, - qq! (#$custnum)</A> | <A HREF="../">Main menu</A></CENTER><BR>!; +$custnum = $cust_pkg->getfield('custnum'); +print $cgi->header( '-expires' => 'now' ), header('Package View', menubar( + "View this customer (#$custnum)" => popurl(2). "view/cust_main.cgi?$custnum", + 'Main Menu' => popurl(2) +)); #print info -my($susp,$cancel,$expire)=( +($susp,$cancel,$expire)=( $cust_pkg->getfield('susp'), $cust_pkg->getfield('cancel'), $cust_pkg->getfield('expire'), ); -print "<FONT SIZE=+1><CENTER>Package #<B>$pkgnum</B></FONT>"; -print qq!<BR><A HREF="#package">Package Information</A>!; -print qq! | <A HREF="#services">Service Information</A>! unless $cancel; -print qq!</CENTER><HR>\n!; - -my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment')); -print qq!<A NAME="package"><CENTER><FONT SIZE=+1>Package Information!, - qq!</FONT></A>!; -print qq!<BR><A HREF="../unimp.html">Edit this information</A></CENTER>!; -print "<P>Package: <B>$pkg - $comment</B>"; - -my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill')); -print "<BR>Setup: <B>", $setup ? time2str("%D",$setup) : "(Not setup)" ,"</B>"; -print "<BR>Next bill: <B>", $bill ? time2str("%D",$bill) : "" ,"</B>"; - -if ($susp) { - print "<BR>Suspended: <B>", time2str("%D",$susp), "</B>"; - print qq! <A HREF="../misc/unsusp_pkg.cgi?$pkgnum">Unsuspend</A>! unless $cancel; -} else { - print qq!<BR><A HREF="../misc/susp_pkg.cgi?$pkgnum">Suspend</A>! unless $cancel; -} - -if ($expire) { - print "<BR>Expire: <B>", time2str("%D",$expire), "</B>"; -} - print <<END; -<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post"> -<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> -Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" > -<INPUT TYPE="submit" VALUE="Cancel later"> -END - -if ($cancel) { - print "<BR>Cancelled: <B>", time2str("%D",$cancel), "</B>"; -} else { - print qq!<BR><A HREF="../misc/cancel_pkg.cgi?$pkgnum">Cancel now</A>!; -} - -#otaker -my($otaker)=$cust_pkg->getfield('otaker'); -print "<P>Order taken by <B>$otaker</B>"; +($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment')); +($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill')); +$otaker = $cust_pkg->getfield('otaker'); + +print "Package information"; +print ' (<A HREF="'. popurl(2). 'misc/unsusp_pkg.cgi?'. $pkgnum. + '">unsuspend</A>)' if ( $susp && ! $cancel ); +print ' (<A HREF="'. popurl(2). 'misc/susp_pkg.cgi?'. $pkgnum. + '">suspend</A>)' unless ( $susp || $cancel ); +print ' (<A HREF="'. popurl(2). 'misc/cancel_pkg.cgi?'. $pkgnum. + '">cancel</A>)' unless $cancel; + +print &ntable("#c0c0c0"), '<TR><TD>', &ntable("#c0c0c0",2), + '<TR><TD ALIGN="right">Package number</TD><TD BGCOLOR="#ffffff">', + $pkgnum, '</TD></TR>', + '<TR><TD ALIGN="right">Package</TD><TD BGCOLOR="#ffffff">', + $pkg, '</TD></TR>', + '<TR><TD ALIGN="right">Comment</TD><TD BGCOLOR="#ffffff">', + $comment, '</TD></TR>', + '<TR><TD ALIGN="right">Setup date</TD><TD BGCOLOR="#ffffff">', + ( $setup ? time2str("%D",$setup) : "(Not setup)" ), '</TD></TR>', + '<TR><TD ALIGN="right">Next bill date</TD><TD BGCOLOR="#ffffff">', + ( $bill ? time2str("%D",$bill) : " " ), '</TD></TR>', +; +print '<TR><TD ALIGN="right">Suspension date</TD><TD BGCOLOR="#ffffff">', + time2str("%D",$susp), '</TD></TR>' if $susp; +print '<TR><TD ALIGN="right">Expiration date</TD><TD BGCOLOR="#ffffff">', + time2str("%D",$expire), '</TD></TR>' if $expire; +print '<TR><TD ALIGN="right">Cancellation date</TD><TD BGCOLOR="#ffffff">', + time2str("%D",$cancel), '</TD></TR>' if $cancel; +print '<TR><TD ALIGN="right">Order taker</TD><TD BGCOLOR="#ffffff">', + $otaker, '</TD></TR>', + '</TABLE></TD></TR></TABLE>' +; + +# print <<END; +#<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post"> +#<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum"> +#Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" > +#<INPUT TYPE="submit" VALUE="Cancel later"> +#END unless ($cancel) { #services - print <<END; -<HR><A NAME="services"><CENTER><FONT SIZE=+1>Service Information</FONT></A> -<BR>Click on service to view/edit/add service.</CENTER><BR> -<CENTER><B>Do NOT pick the "Link to existing" option unless you are auditing!!!</B></CENTER> -<CENTER><TABLE BORDER=4> -<TR><TH>Service</TH> -END + print '<BR>Service Information', &table(); #list of services this pkgpart includes - my($pkg_svc,%pkg_svc); + my $pkg_svc; + my %pkg_svc = (); foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $cust_pkg->pkgpart }) ) { $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity; } #list of records from cust_svc - my($svcpart); + my $svcpart; foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) { my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc'); @@ -150,8 +170,9 @@ END my($cust_svc); if ( $cust_svc=shift @cust_svc ) { my($svcnum)=$cust_svc->svcnum; + my($label, $value, $svcdb) = $cust_svc->label; print <<END; -<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc<A></TD></TR> +<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc: $value<A></TD></TR> END } else { print <<END; @@ -169,8 +190,12 @@ END warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;; } - print "</TABLE></CENTER>"; - + print "</TABLE><FONT SIZE=-1>", + "Choose (View) to view or edit an existing service<BR>", + "Choose (Add) to setup a new service<BR>", + "Choose (Link to existing) to link to a legacy (pre-Freeside) service", + "</FONT>" + ; } #formatting diff --git a/htdocs/view/svc_acct.cgi b/htdocs/view/svc_acct.cgi index 7096c2fb1..a191c25dd 100755 --- a/htdocs/view/svc_acct.cgi +++ b/htdocs/view/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# View svc_acct records +# $Id: svc_acct.cgi,v 1.9 1999-04-08 12:00:19 ivan Exp $ # # Usage: svc_acct.cgi svcnum # http://server.name/path/svc_acct.cgi?svcnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-dec-17 # # added link to send info @@ -33,122 +31,119 @@ # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17 # # displays arbitrary radius attributes ivan@sisd.com 98-aug-16 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.9 1999-04-08 12:00:19 ivan +# aesthetic update +# +# Revision 1.8 1999/02/28 00:04:02 ivan +# removed misleading comments +# +# Revision 1.7 1999/01/19 05:14:21 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:45 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1999/01/18 09:22:36 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.4 1998/12/23 03:09:19 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 09:57:23 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/12/16 05:24:29 ivan +# use FS::Conf; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); -use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs fields); - -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1; -} grep $_ !~ /^(#|$)/, <DOMAIN>; - -my($cgi) = new CGI::Base; -$cgi->get; +use vars qw( $conf $cgi $mydomain $query $svcnum $svc_acct $cust_svc $pkgnum + $cust_pkg $custnum $part_svc $p $svc_acct_pop ); +use CGI; +use CGI::Carp qw( fatalsToBrowser ); +use FS::UID qw( cgisuidsetup ); +use FS::CGI qw( header popurl menubar); +use FS::Record qw( qsearchs fields ); +use FS::Conf; +use FS::svc_acct; +use FS::cust_svc; +use FS::cust_pkg; +use FS::part_svc; +use FS::svc_acct_pop; + +$cgi = new CGI; &cgisuidsetup($cgi); -#untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; -my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svcnum}); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); + +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; +$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum}); die "Unkonwn svcnum" unless $svc_acct; -my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); -my($pkgnum)=$cust_svc->getfield('pkgnum'); -my($cust_pkg,$custnum); +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); +} else { + $cust_pkg = ''; + $custnum = ''; } -my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); +$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); die "Unkonwn svcpart" unless $part_svc; -SendHeaders(); # one guess. -print <<END; -<HTML> - <HEAD> - <TITLE>Account View</TITLE> - </HEAD> - <BODY> - <CENTER><H1>Account View</H1> - <BASEFONT SIZE=3> -<CENTER> -END +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Account View', menubar( + ( ( $pkgnum || $custnum ) + ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum", + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", + ) + : ( "Cancel this (unaudited) account" => + "${p}misc/cancel-unaudited.cgi?$svcnum" ) + ), + "Main menu" => $p, +)); -if ($pkgnum || $custnum) { - print <<END; -<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> | -<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | -END -} else { - print <<END; -<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> | -END -} - -print <<END; -<A HREF="../">Main menu</A></CENTER><BR> -<FONT SIZE=+1>Service #$svcnum</FONT> -END - -print qq!<BR><A HREF="../edit/svc_acct.cgi?$svcnum">Edit this information</A>!; #print qq!<BR><A HREF="../misc/sendconfig.cgi?$svcnum">Send account information</A>!; -print qq!<BR><BR><A HREF="#general">General</A> | <A HREF="#shell">Shell account</A> | !; -print qq!<A HREF="#slip">SLIP/PPP account</A></CENTER>!; - -#formatting -print qq!<HR><CENTER><FONT SIZE=+1><A NAME="general">General</A></FONT></CENTER>!; - -#svc -print "Service: <B>", $part_svc->svc, "</B>"; - -#username -print "<BR>Username: <B>", $svc_acct->username, "</B>"; -#password +print qq!<A HREF="${p}edit/svc_acct.cgi?$svcnum">Edit this information</A>!, + "<BR>Service #$svcnum", + "<BR>Service: <B>", $part_svc->svc, "</B>", + "<BR><BR>Username: <B>", $svc_acct->username, "</B>" +; if (substr($svc_acct->_password,0,1) eq "*") { - print "<BR>Password: <I>(Login disabled)</I><BR>"; + print "<BR>Password: <I>(Login disabled)</I>"; } else { - print "<BR>Password: <I>(hidden)</I><BR>"; + print "<BR>Password: <I>(hidden)</I>"; } -# popnum -> svc_acct_pop record -my($svc_acct_pop)=qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum}); - -#pop -print "POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state, +$svc_acct_pop = qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum}); +print "<BR>POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state, " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "<\B>" if $svc_acct_pop; -#shell account -print qq!<HR><CENTER><FONT SIZE=+1><A NAME="shell">!; if ($svc_acct->uid ne '') { - print "Shell account"; - print "</A></FONT></CENTER>"; - print "Uid: <B>", $svc_acct->uid, "</B>"; - print "<BR>Gid: <B>", $svc_acct->gid, "</B>"; - - print qq!<BR>Finger name: <B>!, $svc_acct->finger, qq!</B><BR>!; - - print "Home directory: <B>", $svc_acct->dir, "</B><BR>"; - - print "Shell: <B>", $svc_acct->shell, "</B><BR>"; - - print "Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>"; + print "<BR><BR>Uid: <B>", $svc_acct->uid, "</B>", + "<BR>Gid: <B>", $svc_acct->gid, "</B>", + "<BR>Finger name: <B>", $svc_acct->finger, "</B>", + "<BR>Home directory: <B>", $svc_acct->dir, "</B>", + "<BR>Shell: <B>", $svc_acct->shell, "</B>", + "<BR>Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>" + ; } else { - print "No shell account.</A></FONT></CENTER>"; + print "<BR><BR>(No shell account)"; } -# SLIP/PPP -print qq!<HR><CENTER><FONT SIZE=+1><A NAME="slip">!; if ($svc_acct->slipip) { - print "SLIP/PPP account</A></FONT></CENTER>"; - print "IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>"; + print "<BR><BR>IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>"; my($attribute); foreach $attribute ( grep /^radius_/, fields('svc_acct') ) { #warn $attribute; @@ -158,15 +153,8 @@ if ($svc_acct->slipip) { print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>"; } } else { - print "No SLIP/PPP account</A></FONT></CENTER>" + print "<BR><BR>(No SLIP/PPP account)"; } -print "<HR>"; - - #formatting - print <<END; - - </BODY> -</HTML> -END +print "</BODY></HTML>"; diff --git a/htdocs/view/svc_acct_sm.cgi b/htdocs/view/svc_acct_sm.cgi index 42623eefd..51fbc0351 100755 --- a/htdocs/view/svc_acct_sm.cgi +++ b/htdocs/view/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# View svc_acct_sm records +# $Id: svc_acct_sm.cgi,v 1.10 1999-04-08 12:00:19 ivan Exp $ # # Usage: svc_acct_sm.cgi svcnum # http://server.name/path/svc_acct_sm.cgi?svcnum # -# Note: Should be run setuid freeside as user nobody. -# # based on view/svc_acct.cgi # # ivan@voicenet.com 97-jan-5 @@ -20,95 +18,106 @@ # bmccane@maxbaud.net 98-apr-3 # # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.10 1999-04-08 12:00:19 ivan +# aesthetic update +# +# Revision 1.9 1999/02/28 00:04:03 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/09 09:23:00 ivan +# visual and bugfixes +# +# 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/; +# +# Revision 1.5 1999/01/18 09:41:46 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 03:09:52 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 09:57:24 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/12/16 05:24:30 ivan +# use FS::Conf; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw($conf $cgi $mydomain $query $svcnum $svc_acct_sm $cust_svc + $pkgnum $cust_pkg $custnum $part_svc $p $domsvc $domuid $domuser + $svc $svc_domain $domain $svc_acct $username ); +use CGI; use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl menubar ); use FS::Record qw(qsearchs); - -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1 -} grep $_ !~ /^(#|$)/, <DOMAIN>; -close DOMAIN; - -my($cgi) = new CGI::Base; -$cgi->get; +use FS::Conf; +use FS::svc_acct_sm; +use FS::cust_svc; +use FS::cust_pkg; +use FS::part_svc; +use FS::svc_domain; +use FS::svc_acct; + +$cgi = new CGI; cgisuidsetup($cgi); -#untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; -my($svc_acct_sm)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); + +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; +$svc_acct_sm = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}); die "Unknown svcnum" unless $svc_acct_sm; -my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); -my($pkgnum)=$cust_svc->getfield('pkgnum'); -my($cust_pkg,$custnum); +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); -} - -my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); -die "Unkonwn svcpart" unless $part_svc; - -SendHeaders(); # one guess. -print <<END; -<HTML> - <HEAD> - <TITLE>Mail Alias View</TITLE> - </HEAD> - <BODY> - <CENTER><H1>Mail Alias View</H1> -END -if ($pkgnum || $custnum) { - print <<END; -<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> | -<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | -END } else { - print <<END; -<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> | -END + $cust_pkg = ''; + $custnum = ''; } -print <<END; - <A HREF="../">Main menu</A></CENTER><BR< - <FONT SIZE=+1>Service #$svcnum</FONT> - <P><A HREF="../edit/svc_acct_sm.cgi?$svcnum">Edit this information</A> - <BASEFONT SIZE=3> -END +$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); +die "Unkonwn svcpart" unless $part_svc; -my($domsvc,$domuid,$domuser)=( +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Mail Alias View', menubar( + ( ( $pkgnum || $custnum ) + ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum", + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", + ) + : ( "Cancel this (unaudited) account" => + "${p}misc/cancel-unaudited.cgi?$svcnum" ) + ), + "Main menu" => $p, +)); + +($domsvc,$domuid,$domuser) = ( $svc_acct_sm->domsvc, $svc_acct_sm->domuid, $svc_acct_sm->domuser, ); -my($svc) = $part_svc->svc; -my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc}); -my($domain)=$svc_domain->domain; -my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid}); -my($username)=$svc_acct->username; - -#formatting -print qq!<HR>!; - -#svc -print "Service: <B>$svc</B>"; - -print "<HR>"; - -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; - - </BODY> -</HTML> -END +$svc = $part_svc->svc; +$svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc}); +$domain = $svc_domain->domain; +$svc_acct = qsearchs('svc_acct',{'uid'=>$domuid}); +$username = $svc_acct->username; + +print qq!<A HREF="${p}edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>!, + "<BR>Service #$svcnum", + "<BR>Service: <B>$svc</B>", + qq!<BR>Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!, + '</BODY></HTML>' +; diff --git a/htdocs/view/svc_domain.cgi b/htdocs/view/svc_domain.cgi index 78ff6ac0b..90526973d 100755 --- a/htdocs/view/svc_domain.cgi +++ b/htdocs/view/svc_domain.cgi @@ -1,76 +1,96 @@ #!/usr/bin/perl -Tw # -# View svc_domain records +# $Id: svc_domain.cgi,v 1.9 1999-04-08 12:00:19 ivan Exp $ # # Usage: svc_domain svcnum # http://server.name/path/svc_domain.cgi?svcnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 97-jan-6 # # rewrite 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.9 1999-04-08 12:00:19 ivan +# aesthetic update +# +# Revision 1.8 1999/02/28 00:04:04 ivan +# removed misleading comments +# +# Revision 1.7 1999/02/23 08:09:25 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.6 1999/01/19 05:14:23 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:47 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 03:10:19 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 09:57:25 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/11/13 09:56:50 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $query $svcnum $svc_domain $domain $cust_svc $pkgnum + $cust_pkg $custnum $part_svc $p ); +use CGI; use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header menubar popurl menubar); use FS::Record qw(qsearchs); +use FS::svc_domain; +use FS::cust_svc; +use FS::cust_pkg; +use FS::part_svc; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; -my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svcnum}); +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; +$svc_domain = qsearchs('svc_domain',{'svcnum'=>$svcnum}); die "Unknown svcnum" unless $svc_domain; -my($domain)=$svc_domain->domain; -my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); -my($pkgnum)=$cust_svc->getfield('pkgnum'); -my($cust_pkg,$custnum); +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); +} else { + $cust_pkg = ''; + $custnum = ''; } -my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); +$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); die "Unkonwn svcpart" unless $part_svc; -SendHeaders(); # one guess. -print <<END; -<HTML> - <HEAD> - <TITLE>Domain View</TITLE> - </HEAD> - <BODY> - <CENTER><H1>Domain View</H1> - <BASEFONT SIZE=3> -<CENTER> -<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> | -<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | -<A HREF="../">Main menu</A></CENTER><BR> - <FONT SIZE=+1>Service #$svcnum</FONT> - </CENTER> -END - -print "<HR>"; -print "Service: <B>", $part_svc->svc, "</B>"; -print "<HR>"; - -print qq!Domain name <B>$domain</B>.!; -print qq!<P><A HREF="http://rs.internic.net/cgi-bin/whois?do+$domain">View whois information.</A>!; - -print "<HR>"; - - #formatting - print <<END; - - </BODY> -</HTML> -END +$domain = $svc_domain->domain; +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Domain View', menubar( + ( ( $pkgnum || $custnum ) + ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum", + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", + ) + : ( "Cancel this (unaudited) account" => + "${p}misc/cancel-unaudited.cgi?$svcnum" ) + ), + "Main menu" => $p, +)), + "Service #$svcnum", + "<BR>Service: <B>", $part_svc->svc, "</B>", + "<BR>Domain name: <B>$domain</B>.", + qq!<BR><BR><A HREF="http://rs.internic.net/cgi-bin/whois?do+$domain">View whois information.</A>!, + '</BODY></HTML>', +; |
