'freeside_1_4_0_pre13'.
--- /dev/null
+templated web interface (start, anyway)
+separate billing and service addresses
+customer comments
+edit/part_svc.cgi
+svc_forward and better dealing with virtualdomains! and realm export to RADIUS
+customer-to-customer referrals
+quick order
+no more single default domain
+
+no more postgres/RADIUS weirdness yay!, 31 character column names etc.
+PostgreSQL no longer needs to be recompiled for long RADIUS attributes.
+RADIUS integration and RADIUS attribute defaults updated.
+
+Fuzzy searches on large data sets are much faster.
+
+Job queues have been implemented.
+
+Integration with Cyrus IMAP server.
+
+Support for instant (previously only batch) update of an ICRADIUS or
+FreeRADIUS stored in a local or remote MySQL installation (separate from
+the Freeside database)
+
+1.4.0 has a new Authorize.Net interface, updated for Authorize.Net 3.0
+
+completely templated signup server
+
+items setup/recur tax exempt flag
+
+jeff!
+
+Price plans. For starters, multi-level customer-to-customer commissions
+in addition to flat rate pricing. Price plans are written in Perl and
+it's straightforward to add new ones. I'm expect we'll see plans for
+pro-rating, metered billing and the like soon.
+
+New UI for packages and price plans.
+
+Per-package tax exemption for setup and/or recurring fee
+
+New UI in the signup server, new customer and new account pages that
+breaks down access numbers by state and should be easier to use for a
+large number of dialup numbers. (POPs)
+
+Database support for local call mappin - the data on what exchanges
+can call which of your access numbers as a local call.
+
+easier installation/instructions & web configuration
+
+expedited payment-entry
+- a quick check entry tool for entering large numbers of checks as well
+ as customer information on the payment entry screen
+
+- automatic application of payments and credits to outstanding invoices
+
+#freeside-overdue
+#- the `freeside-overdue' script to list, add postal invoicing, suspend,
+# or cancel overdue and/or expired accounts.
+
+- Payments and credits are applied against invoices when posted.
+
+- A bunch of UI fixes/tweaks: package browse, payment/credit entry, search
+ by check #, others
+
+ - Web interface for per-hour or per-minute account charges using the
+ session monitor.
+
+ - Invoice events - set late fees, suspension, cancellation, etc. events
+ on overdue invoices.
+
+ - Packages and service disable flags for a more manageable UI.
+
+HTML manpages now up-to-date and generated on install
+
+schema changes for more configurable export
+
+no mysql support :(
+
+invoice events work & show up on invoice view
+
+- Pro-rating price plan
+
+- svc_www for virtual host services
+-svc_www is here, better support for apache integration
+
+- fs_passwd/fs_passwd.cgi web-based password changer for users
+
+LinkPoint support
+
+Most notably, the main menu has gotten a significant facelift and should
+be easier to understand and use.
+
+New frequently-requested financial reports contributed by Jeff Finucane,
+thanks!
+
+The queue daemon web UI has been finished - you can now retry and remove
+jobs, error messages from failed jobs appear on the web interface, and
+account detail pages show any pending provisioning jobs for thsoe
+accounts.
+
+fs-setup should work under MySQL again. The browse links are still broken
+("all customers", "all packages", "all accounts") but at least you should
+be able to get everything else working...
+
+Critical Path provisioning has been updated and can now username changes
+and suspension/unsuspension.
+
+--
+
+- New export code!
+- Name and company searches:
+ - now case-insensative
+ - pulldown for search type
+- Email notification for deleted payments
+- History tables - complete history of all database changes
+- Alternate invoice templates for things like late noitces
+- ICRADIUS groups (usergroup table if not radgroupreply & radgroupcheck)
+- Signup server
+ - Error messages in message catalog
+ - Agent is now selectable (multiple signup servers for different agents
+ can now run on the same machine)
+ - signup_server-realtime configuration option to run cards immediately
+ - signup-alternate.html example for free and pay packages on the same
+ signup page
+- Texas tax
+
+schema diagram
+
+--
+
Thanks to Matt Simerson <matt@michweb.net> of MichWeb Inc. for documentation
-and pre-release testing. Without his help the documentation in the first
+and pre-release testing. Without his help the documentation in 1.0.0
release would have consisted of a single screenfull of text.
+(To clear up some misunderstanding, Matt did not write the current
+documentation.)
-# Steve Cleff <cleff@yahoo.com> did the default background image and is also
-# the creator of Freeside's mascot, Snakeman.
+Steve Cleff <cleff@yahoo.com> did the default background image in 1.0.x and
+is also the creator of Freeside's elusive mascot, Snakeman, who we hope will
+make an appearance in an upcoming version.
-Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic.
+Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic used in
+1.0.x and most of 1.1.x.
+
+Mark Norris of Urban Design, Inc. <http://www.urban.com/> did the red "S"
+logo for later 1.1.x versions and 1.2.x
Brian McCane? <bmccane@maxbaud.net> contributed PostgreSQL support, HTML
style enhancements and many, many bugfixes.
-Everything else is my (Ivan Kohler <ivan@sisd.com>) fault.
+Cerkit <cerkit@alfheim.net> contributed rsync support and desynced hosts.
+His changes will hopefully be included in an upcoming version.
+
+CompleteHOST, Inc. (http://www.completehost.com) funded the development of the
+following features:
+ - Multiple, separate databases and configurations on one box.
+ - Per-customer pricing (custom packages)
+ - Internationalization wrt addresses (cust_main, cust_main_county)
+Thanks!
+
+Mark Williamson <mark.williamson@ebbs.com.au> and Roger Mangraviti
+<rem@atu.com.au> contributed state/provence listings for Australia.
+
+Peter Wemm <peter@netplex.com.au> sent in a bunch of bugfixes for the 1.2
+release.
+
+Greg Kuhnert <gregk@no1.com.au> sent some documentation updates.
+
+Joel Griffiths <griff@aver-computer.com> contribued many bugfixes as well as
+the print-batch script.
+
+NetLoud <http://www.netloud.com/> funded the development of the following
+features:
+ - IEAK support for the signup server
+ - Pre-payment support
+
+NetAcces.Net (not netaccess.net) funded the development of the following
+features:
+ - DNS tracking and export to BIND configuration files
+ - Web site virtual host tracking and export to Apache configuration files
+
+Kristian Hoffmann <khoff@pc-intouch.com> contributed Netscape CCK
+autoconfiguration support for the signup server, lots of great mailing
+lists posts which I shamelessly made into documentation, fixes to get rid of
+the embarassing and non-database-normal "owed" field, and many other things
+I'm forgetting.
+
+Jeff Finucane <jeff@cmh.net> send in a bunch of bugfixes (for the sendmail
+export, cancel-unaudited.cgi), patches to support billing date modification,
+and probably other things too (sorry if I forgot them). And yet even more
+bug squashing, thanks! *and* he single-handedly implemented all the necessary
+work to get rid of svc_acct_sm and the "default domain" thanks!! and rewrote
+the financials! wow, thanks jeff! and contributed financial reports!
+
+Kenny Elliott <kenny@neoserve.com> contributed ICRADIUS radreply table support,
+allowing attributes with ICRADIUS, helped fix many bugs, and some
+other stuff I can't recall (sorry).
+
+Stephen Amadei <amadei@dandy.net> contribued portability cleanups for the
+low-level DBI stuff.
+
+Jason Spence <thalakan@frys.com> contributed admin.html and other
+documentation, autocapnames javascript, bugfixes & other neat stuff I can't
+remember.
+
+Brad Dameron <bdameron@tscnet.com> contributed code to do configurable state
+and referral defaults.
+
+Surf and Sip, Inc., <http://www.surfandsip.com> sponsored a long-requested
+feature - the session monitor and time-based prepaid cards.
+Matt Peterson <matt@peterson.org> and Mack ? <mackn@mackn.net> tested
+the new features and contributed many bugfixes.
+
+Landel Telecom <http://www.landel.com/> sponsored shipping addresses and
+customer notes, as well as an update of the CP provisioning.
+
+nikotel, Inc. <http://www.nikojet.com> sponsored the inclusion of
+customer-to-customer referrals in the web interface and signup server.
+
+Three Bubba's Innanet <http://www.inna.net> sponsored expedited check entry,
+the "similar names warning" feature, and a number of other enhancements.
+
+Dave Burgess <burgess@neonramp.com> sent in a bunch of fixes and small changes
+and will doubtless send more once he's got his tree under control.
+
+Luke Pfeifer <freeside@globalli.com> contributed the "subscription" price plan.
+
+Noment Networks, LLC <http://www.noment.com/> sponsored ICRADIUS/FreeRADIUS
+groups, message catalogs, and signup server enhancements.
+
+Everything else is my (Ivan Kohler <ivan@420.am>) fault.
--- /dev/null
+Revision history for Perl extension FS.
+
+0.01 Wed Aug 4 00:13:45 1999
+ - original version; created by h2xs 1.19
+
--- /dev/null
+package FS;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.01';
+
+#find missing entries in this file with:
+# for a in `ls *pm | cut -d. -f1`; do grep 'L<FS::'$a'>' ../FS.pm >/dev/null || echo "missing $a" ; done
+
+1;
+__END__
+
+=head1 NAME
+
+FS - Freeside Perl modules
+
+=head1 SYNOPSIS
+
+Freeside perl modules and CLI utilities.
+
+=head2 Utility classes
+
+L<FS::Conf> - Freeside configuration values
+
+L<FS::ConfItem> - Freeside configuration option meta-data.
+
+L<FS::UID> - User class (not yet OO)
+
+L<FS::CGI> - Non OO-subroutines for the web interface.
+
+L<FS::Msgcat> - Message catalog
+
+L<FS::SearchCache> - Search cache
+
+L<FS::raddb> - RADIUS dictionary
+
+=head2 Database record classes
+
+L<FS::Record> - Database record base class
+
+L<FS::svc_acct_pop> - POP (Point of Presence, not Post
+Office Protocol) class
+
+L<FS::part_pop_local> - Local calling area class
+
+L<FS::part_referral> - Referral class
+
+L<FS::cust_main_county> - Locale (tax rate) class
+
+L<FS::cust_tax_exempt> - Tax exemption record class
+
+L<FS::svc_Common> - Service base class
+
+L<FS::svc_acct> - Account (shell, RADIUS, POP3) class
+
+L<FS::radius_usergroup> - RADIUS groups
+
+L<FS::svc_domain> - Domain class
+
+L<FS::domain_record> - DNS zone entries
+
+L<FS::svc_forward> - Mail forwarding class
+
+L<FS::svc_acct_sm> - (Depreciated) Vitual mail alias class
+
+L<FS::svc_www> - Web virtual host class.
+
+L<FS::part_svc> - Service definition class
+
+L<FS::part_svc_column> - Column constraint class
+
+L<FS::export_svc> - Class linking service definitions (see L<FS::part_svc>)
+with exports (see L<FS::part_export>)
+
+L<FS::part_export> - External provisioning export class
+
+L<FS::part_export_option> - Export option class
+
+L<FS::part_pkg> - Package (billing item) definition class
+
+L<FS::pkg_svc> - Class linking package (billing item)
+definitions (see L<FS::part_pkg>) with service definitions
+(see L<FS::part_svc>)
+
+L<FS::agent> - Agent (reseller) class
+
+L<FS::agent_type> - Agent type class
+
+L<FS::type_pkgs> - Class linking agent types (see
+L<FS::agent_type>) with package (billing item) definitions
+(see L<FS::part_pkg>)
+
+L<FS::cust_svc> - Service class
+
+L<FS::cust_pkg> - Package (billing item) class
+
+L<FS::cust_main> - Customer class
+
+L<FS::cust_main_invoice> - Invoice destination
+class
+
+L<FS::cust_bill> - Invoice class
+
+L<FS::cust_bill_pkg> - Invoice line item class
+
+L<FS::part_bill_event> - Invoice event definition class
+
+L<FS::cust_bill_event> - Completed invoice event class
+
+L<FS::cust_pay> - Payment class
+
+L<FS::cust_bill_pay> - Payment application class
+
+L<FS::cust_credit> - Credit class
+
+L<FS::cust_refund> - Refund class
+
+L<FS::cust_credit_refund> - Refund application class
+
+L<FS::cust_credit_bill> - Credit invoice application class
+
+L<FS::cust_pay_batch> - Credit card transaction queue class
+
+L<FS::prepay_credit> - Prepaid "calling card" credit class.
+
+L<FS::nas> - Network Access Server class
+
+L<FS::port> - NAS port class
+
+L<FS::session> - User login session class
+
+L<FS::queue> - Job queue
+
+L<FS::queue_arg> - Job arguments
+
+L<FS::queue_depend> - Job dependencies
+
+L<FS::msgcat> - Message catalogs
+
+=head1 Remote API modules
+
+L<FS::SignupClient>
+
+L<FS::SessionClient>
+
+L<FS::MailAdminServer>
+
+=head2 Command-line utilities
+
+L<freeside-adduser>
+
+L<freeside-queued>
+
+L<freeside-daily>
+
+L<freeside-expiration-alerter>
+
+L<freeside-email>
+
+L<freeside-cc-receipts-report>
+
+L<freeside-credit-report>
+
+L<freeside-receivables-report>
+
+L<freeside-tax-report>
+
+L<freeside-bill>
+
+L<freeside-overdue>
+
+=head2 User Interface classes (under (stalled) development; not yet usable)
+
+L<FS::UI::Base> - User-interface base class
+
+L<FS::UI::Gtk> - Gtk user-interface class
+
+L<FS::UI::CGI> - CGI (HTML) user-interface class
+
+L<FS::UI::agent> - agent table user-interface class
+
+=head2 Notes
+
+To quote perl(1), "If you're intending to read these straight through for the
+first time, the suggested order will tend to reduce the number of forward
+references."
+
+If you've never used OO modules before,
+http://www.cpan.org/doc/FMTEYEWTK/easy_objects.html might help you out.
+
+=head1 DESCRIPTION
+
+Freeside is a billing and administration package for Internet Service
+Providers.
+
+The Freeside home page is at <http://www.sisd.com/freeside>.
+
+The main documentation is in httemplate/docs.
+
+=head1 SUPPORT
+
+A mailing list for users is available. Send a blank message to
+<ivan-freeside-subscribe@sisd.com> to subscribe.
+
+A mailing list for developers is available. It is intended to be lower volume
+and higher SNR than the users list. Send a blank message to
+<ivan-freeside-devel-subscribe@sisd.com> to subscribe.
+
+Commercial support is available; see
+<http://www.sisd.com/freeside/commercial.html>.
+
+=head1 AUTHOR
+
+Primarily Ivan Kohler <ivan@sisd.com>, with help from many kind folks.
+
+See the CREDITS file in the Freeside distribution for a (hopefully) complete
+list and the individal files for details.
+
+=head1 SEE ALSO
+
+perl(1), main Freeside documentation in htdocs/docs/
+
+=head1 BUGS
+
+Those modules which would be useful separately should be pulled out,
+renamed appropriately and uploaded to CPAN. So far: DBIx::DBSchema, Net::SSH
+and Net::SCP...
+
+=cut
+
--- /dev/null
+package FS::CGI;
+
+use strict;
+use vars qw(@EXPORT_OK @ISA @header);
+use Exporter;
+use CGI;
+use URI::URL;
+#use CGI::Carp qw(fatalsToBrowser);
+use FS::UID;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(header menubar idiot eidiot popurl table itable ntable
+ small_custview myexit);
+
+=head1 NAME
+
+FS::CGI - Subroutines for the web interface
+
+=head1 SYNOPSIS
+
+ use FS::CGI qw(header menubar idiot eidiot popurl);
+
+ print header( 'Title', '' );
+ print header( 'Title', menubar('item', 'URL', ... ) );
+
+ idiot "error message";
+ eidiot "error message";
+
+ $url = popurl; #returns current url
+ $url = popurl(3); #three levels up
+
+=head1 DESCRIPTION
+
+Provides a few common subroutines for the web interface.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item header TITLE, MENUBAR
+
+Returns an HTML header.
+
+=cut
+
+sub header {
+ my($title,$menubar,$etc)=@_; #$etc is for things like onLoad= etc.
+ #use Carp;
+ $etc = '' unless defined $etc;
+
+ my $x = <<END;
+ <HTML>
+ <HEAD>
+ <TITLE>
+ $title
+ </TITLE>
+ <META HTTP-Equiv="Cache-Control" Content="no-cache">
+ <META HTTP-Equiv="Pragma" Content="no-cache">
+ <META HTTP-Equiv="Expires" Content="0">
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8"$etc>
+ <FONT SIZE=7>
+ $title
+ </FONT>
+ <BR><BR>
+END
+ $x .= $menubar. "<BR><BR>" if $menubar;
+ $x;
+}
+
+=item menubar ITEM, URL, ...
+
+Returns an HTML menubar.
+
+=cut
+
+sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... );
+ my($item,$url,@html);
+ while (@_) {
+ ($item,$url)=splice(@_,0,2);
+ push @html, qq!<A HREF="$url">$item</A>!;
+ }
+ join(' | ',@html);
+}
+
+=item idiot ERROR
+
+This is depriciated. Don't use it.
+
+Sends an HTML error message.
+
+=cut
+
+sub idiot {
+ #warn "idiot depriciated";
+ my($error)=@_;
+# my $cgi = &FS::UID::cgi();
+# if ( $cgi->isa('CGI::Base') ) {
+# no strict 'subs';
+# &CGI::Base::SendHeaders;
+# } else {
+# print $cgi->header( @FS::CGI::header );
+# }
+ print <<END;
+<HTML>
+ <HEAD>
+ <TITLE>Error processing your request</TITLE>
+ <META HTTP-Equiv="Cache-Control" Content="no-cache">
+ <META HTTP-Equiv="Pragma" Content="no-cache">
+ <META HTTP-Equiv="Expires" Content="0">
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H4>Error processing your request</H4>
+ </CENTER>
+ Your request could not be processed because of the following error:
+ <P><B>$error</B>
+ </BODY>
+</HTML>
+END
+
+}
+
+=item eidiot ERROR
+
+This is depriciated. Don't use it.
+
+Sends an HTML error message, then exits.
+
+=cut
+
+sub eidiot {
+ warn "eidiot depriciated";
+ $HTML::Mason::Commands::r->send_http_header
+ if defined $HTML::Mason::Commands::r;
+ idiot(@_);
+ &myexit();
+}
+
+=item myexit
+
+You probably shouldn't use this; but if you must:
+
+If running under mod_perl, calles Apache::exit, otherwise, calls exit.
+
+=cut
+
+sub myexit {
+ if (exists $ENV{MOD_PERL}) {
+
+ if ( defined $main::Response
+ && $main::Response->isa('Apache::ASP::Response') ) { #Apache::ASP
+ $main::Response->End();
+ require Apache;
+ Apache::exit();
+ } elsif ( defined $HTML::Mason::Commands::m ) { #Mason
+ #$HTML::Mason::Commands::m->flush_buffer();
+ $HTML::Mason::Commands::m->abort();
+ die "shouldn't fall through to here (mason \$m->abort didn't)";
+ } else {
+ #??? well, it is $ENV{MOD_PERL}
+ warn "running under unknown mod_perl environment; trying Apache::exit()";
+ require Apache;
+ Apache::exit();
+ }
+ } else {
+ exit;
+ }
+}
+
+=item popurl LEVEL
+
+Returns current URL with LEVEL levels of path removed from the end (default 0).
+
+=cut
+
+sub popurl {
+ my($up)=@_;
+ my $cgi = &FS::UID::cgi;
+ my $url = new URI::URL ( $cgi->isa('Apache') ? $cgi->uri : $cgi->url );
+ my(@path)=$url->path_components;
+ splice @path, 0-$up;
+ $url->path_components(@path);
+ my $x = $url->as_string;
+ $x .= '/' unless $x =~ /\/$/;
+ $x;
+}
+
+=item table
+
+Returns HTML tag for beginning a table.
+
+=cut
+
+sub table {
+ my $col = shift;
+ if ( $col ) {
+ qq!<TABLE BGCOLOR="$col" BORDER=1 WIDTH="100%" CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">!;
+ } else {
+ '<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">';
+ }
+}
+
+=item itable
+
+Returns HTML tag for beginning an (invisible) table.
+
+=cut
+
+sub itable {
+ my $col = shift;
+ my $cellspacing = shift || 0;
+ if ( $col ) {
+ qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!;
+ } else {
+ qq!<TABLE BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!;
+ }
+}
+
+=item ntable
+
+This is getting silly.
+
+=cut
+
+sub ntable {
+ my $col = shift;
+ my $cellspacing = shift || 0;
+ if ( $col ) {
+ qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing>!;
+ } else {
+ '<TABLE BORDER CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">';
+ }
+
+}
+
+=item small_custview CUSTNUM || CUST_MAIN_OBJECT, COUNTRYDEFAULT
+
+Sheesh. I should just switch to Mason.
+
+=cut
+
+sub small_custview {
+ use FS::Record qw(qsearchs);
+ use FS::cust_main;
+
+ my $arg = shift;
+ my $countrydefault = shift || 'US';
+
+ my $cust_main = ref($arg) ? $arg
+ : qsearchs('cust_main', { 'custnum' => $arg } )
+ or die "unknown custnum $arg";
+
+ my $html = 'Customer #<B>'. $cust_main->custnum. '</B>'.
+ ntable('#e8e8e8'). '<TR><TD>'. ntable("#cccccc",2).
+ '<TR><TD ALIGN="right" VALIGN="top">Billing</TD><TD BGCOLOR="#ffffff">'.
+ $cust_main->getfield('last'). ', '. $cust_main->first. '<BR>';
+
+ $html .= $cust_main->company. '<BR>' if $cust_main->company;
+ $html .= $cust_main->address1. '<BR>';
+ $html .= $cust_main->address2. '<BR>' if $cust_main->address2;
+ $html .= $cust_main->city. ', '. $cust_main->state. ' '. $cust_main->zip. '<BR>';
+ $html .= $cust_main->country. '<BR>'
+ if $cust_main->country && $cust_main->country ne $countrydefault;
+
+ $html .= '</TD></TR></TABLE></TD>';
+
+ if ( defined $cust_main->dbdef_table->column('ship_last') ) {
+
+ my $pre = $cust_main->ship_last ? 'ship_' : '';
+
+ $html .= '<TD>'. ntable("#cccccc",2).
+ '<TR><TD ALIGN="right" VALIGN="top">Service</TD><TD BGCOLOR="#ffffff">'.
+ $cust_main->get("${pre}last"). ', '.
+ $cust_main->get("${pre}first"). '<BR>';
+ $html .= $cust_main->get("${pre}company"). '<BR>'
+ if $cust_main->get("${pre}company");
+ $html .= $cust_main->get("${pre}address1"). '<BR>';
+ $html .= $cust_main->get("${pre}address2"). '<BR>'
+ if $cust_main->get("${pre}address2");
+ $html .= $cust_main->get("${pre}city"). ', '.
+ $cust_main->get("${pre}state"). ' '.
+ $cust_main->get("${pre}ship_zip"). '<BR>';
+ $html .= $cust_main->get("${pre}country"). '<BR>'
+ if $cust_main->get("${pre}country")
+ && $cust_main->get("${pre}country") ne $countrydefault;
+
+ $html .= '</TD></TR></TABLE></TD>';
+ }
+
+ $html .= '</TR></TABLE>';
+
+ $html;
+}
+
+=back
+
+=head1 BUGS
+
+Not OO.
+
+Not complete.
+
+small_custview sooooo doesn't belong here. i should just switch to Mason.
+
+=head1 SEE ALSO
+
+L<CGI>, L<CGI::Base>
+
+=cut
+
+1;
+
+
--- /dev/null
+package FS::Conf;
+
+use vars qw($default_dir @config_items $DEBUG );
+use IO::File;
+use File::Basename;
+use FS::ConfItem;
+
+$DEBUG = 0;
+
+=head1 NAME
+
+FS::Conf - Freeside configuration values
+
+=head1 SYNOPSIS
+
+ use FS::Conf;
+
+ $conf = new FS::Conf "/config/directory";
+
+ $FS::Conf::default_dir = "/config/directory";
+ $conf = new FS::Conf;
+
+ $dir = $conf->dir;
+
+ $value = $conf->config('key');
+ @list = $conf->config('key');
+ $bool = $conf->exists('key');
+
+ $conf->touch('key');
+ $conf->set('key' => 'value');
+ $conf->delete('key');
+
+ @config_items = $conf->config_items;
+
+=head1 DESCRIPTION
+
+Read and write Freeside configuration values. Keys currently map to filenames,
+but this may change in the future.
+
+=head1 METHODS
+
+=over 4
+
+=item new [ DIRECTORY ]
+
+Create a new configuration object. A directory arguement is required if
+$FS::Conf::default_dir has not been set.
+
+=cut
+
+sub new {
+ my($proto,$dir) = @_;
+ my($class) = ref($proto) || $proto;
+ my($self) = { 'dir' => $dir || $default_dir } ;
+ bless ($self, $class);
+}
+
+=item dir
+
+Returns the directory.
+
+=cut
+
+sub dir {
+ my($self) = @_;
+ my $dir = $self->{dir};
+ -e $dir or die "FATAL: $dir doesn't exist!";
+ -d $dir or die "FATAL: $dir isn't a directory!";
+ -r $dir or die "FATAL: Can't read $dir!";
+ -x $dir or die "FATAL: $dir not searchable (executable)!";
+ $dir =~ /^(.*)$/;
+ $1;
+}
+
+=item config KEY
+
+Returns the configuration value or values (depending on context) for key.
+
+=cut
+
+sub config {
+ my($self,$file)=@_;
+ my($dir)=$self->dir;
+ my $fh = new IO::File "<$dir/$file" or return;
+ if ( wantarray ) {
+ map {
+ /^(.*)$/
+ or die "Illegal line (array context) in $dir/$file:\n$_\n";
+ $1;
+ } <$fh>;
+ } else {
+ <$fh> =~ /^(.*)$/
+ or die "Illegal line (scalar context) in $dir/$file:\n$_\n";
+ $1;
+ }
+}
+
+=item exists KEY
+
+Returns true if the specified key exists, even if the corresponding value
+is undefined.
+
+=cut
+
+sub exists {
+ my($self,$file)=@_;
+ my($dir) = $self->dir;
+ -e "$dir/$file";
+}
+
+=item touch KEY
+
+Creates the specified configuration key if it does not exist.
+
+=cut
+
+sub touch {
+ my($self, $file) = @_;
+ my $dir = $self->dir;
+ unless ( $self->exists($file) ) {
+ warn "[FS::Conf] TOUCH $file\n" if $DEBUG;
+ system('touch', "$dir/$file");
+ }
+}
+
+=item set KEY VALUE
+
+Sets the specified configuration key to the given value.
+
+=cut
+
+sub set {
+ my($self, $file, $value) = @_;
+ my $dir = $self->dir;
+ $value =~ /^(.*)$/s;
+ $value = $1;
+ unless ( join("\n", @{[ $self->config($file) ]}) eq $value ) {
+ warn "[FS::Conf] SET $file\n" if $DEBUG;
+# warn "$dir" if is_tainted($dir);
+# warn "$dir" if is_tainted($file);
+ chmod 0644, "$dir/$file";
+ my $fh = new IO::File ">$dir/$file" or return;
+ chmod 0644, "$dir/$file";
+ print $fh "$value\n";
+ }
+}
+#sub is_tainted {
+# return ! eval { join('',@_), kill 0; 1; };
+# }
+
+=item delete KEY
+
+Deletes the specified configuration key.
+
+=cut
+
+sub delete {
+ my($self, $file) = @_;
+ my $dir = $self->dir;
+ if ( $self->exists($file) ) {
+ warn "[FS::Conf] DELETE $file\n";
+ unlink "$dir/$file";
+ }
+}
+
+=item config_items
+
+Returns all of the possible configuration items as FS::ConfItem objects. See
+L<FS::ConfItem>.
+
+=cut
+
+sub config_items {
+ my $self = shift;
+ #quelle kludge
+ @config_items,
+ map {
+ my $basename = basename($_);
+ $basename =~ /^(.*)$/;
+ $basename = $1;
+ new FS::ConfItem {
+ 'key' => $basename,
+ 'section' => 'billing',
+ 'description' => 'Alternate template file for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
+ 'type' => 'textarea',
+ }
+ } glob($self->dir. '/invoice_template_*')
+ ;
+}
+
+=back
+
+=head1 BUGS
+
+If this was more than just crud that will never be useful outside Freeside I'd
+worry that config_items is freeside-specific and icky.
+
+=head1 SEE ALSO
+
+"Configuration" in the web interface (config/config.cgi).
+
+httemplate/docs/config.html
+
+=cut
+
+@config_items = map { new FS::ConfItem $_ } (
+
+ {
+ 'key' => 'address',
+ 'section' => 'deprecated',
+ 'description' => 'This configuration option is no longer used. See <a href="#invoice_template">invoice_template</a> instead.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'alerter_template',
+ 'section' => 'billing',
+ 'description' => 'Template file for billing method expiration alerts. See the <a href="../docs/billing.html#invoice_template">billing documentation</a> for details.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'apacheroot',
+ 'section' => 'apache',
+ 'description' => 'The directory containing Apache virtual hosts',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'apacheip',
+ 'section' => 'apache',
+ 'description' => 'The current IP address to assign to new virtual hosts',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'apachemachine',
+ 'section' => 'apache',
+ 'description' => 'A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'apachemachines',
+ 'section' => 'apache',
+ 'description' => 'Your Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf\', which can be included in your Apache configuration via the <a href="http://www.apache.org/docs/mod/core.html#include">Include</a> directive.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'bindprimary',
+ 'section' => 'BIND',
+ 'description' => 'Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'bindsecondaries',
+ 'section' => 'BIND',
+ 'description' => 'Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'business-onlinepayment',
+ 'section' => 'billing',
+ 'description' => '<a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> support, at least three lines: processor, login, and password. An optional fourth line specifies the action or actions (multiple actions are separated with `,\': for example: `Authorization Only, Post Authorization\'). Optional additional lines are passed to Business::OnlinePayment as %processor_options.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'business-onlinepayment-description',
+ 'section' => 'billing',
+ 'description' => 'String passed as the description field to <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a>. Evaluated as a double-quoted perl string, with the following variables available: <code>$agent</code> (the agent name), and <code>$pkgs</code> (a comma-separated list of packages to which the invoiced being charged applies)',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'bsdshellmachines',
+ 'section' => 'shell',
+ 'description' => 'Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'countrydefault',
+ 'section' => 'UI',
+ 'description' => 'Default two-letter country code (if not supplied, the default is `US\')',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'cybercash3.2',
+ 'section' => 'billing',
+ 'description' => '<a href="http://www.cybercash.com/cashregister/">CyberCash Cashregister v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly\' or `mauthcapture\').',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'cyrus',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>cyrus</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'cp_app',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>cp</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>, four lines: "host:port", username, password, and workgroup (for new users).',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'deletecustomers',
+ 'section' => 'UI',
+ 'description' => 'Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers\' packages if they cancel service.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'deletepayments',
+ 'section' => 'UI',
+ 'description' => 'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.',
+ 'type' => [qw( checkbox text )],
+ },
+
+ {
+ 'key' => 'dirhash',
+ 'section' => 'shell',
+ 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'disable_customer_referrals',
+ 'section' => 'UI',
+ 'description' => 'Disable new customer-to-customer referrals in the web interface',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'domain',
+ 'section' => 'deprecated',
+ 'description' => 'Your domain name.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'editreferrals',
+ 'section' => 'UI',
+ 'description' => 'Enable referral modification for existing customers',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'emailinvoiceonly',
+ 'section' => 'billing',
+ 'description' => 'Disables postal mail invoices',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'disablepostalinvoicedefault',
+ 'section' => 'billing',
+ 'description' => 'Disables postal mail invoices as the default option in the UI. Be careful not to setup customers which are not sent invoices. See <a href ="#emailinvoiceauto">emailinvoiceauto</a>.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'emailinvoiceauto',
+ 'section' => 'billing',
+ 'description' => 'Automatically adds new accounts to the email invoice list upon customer creation',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'erpcdmachines',
+ 'section' => '',
+ 'description' => 'Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'hidecancelledpackages',
+ 'section' => 'UI',
+ 'description' => 'Prevent cancelled packages from showing up in listings (though they will still be in the database)',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'hidecancelledcustomers',
+ 'section' => 'UI',
+ 'description' => 'Prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'home',
+ 'section' => 'required',
+ 'description' => 'For new users, prefixed to username to create a directory name. Should have a leading but not a trailing slash.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'icradiusmachines',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the <a href="http://rootwood.haze.st/aspside/config/config-view.cgi#icradius_secrets">icradius_secrets</a> config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option. <blockquote><b>ADDITIONAL DEPRECATED FUNCTIONALITY</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines or <a href="http://www.freeradius.org/">FreeRADIUS</a> (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: <CODE>"radius.isp.tld radius_db radius_user passw0rd"</CODE></blockquote>',
+ 'type' => [qw( checkbox textarea )],
+ },
+
+ {
+ 'key' => 'icradius_mysqldest',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'icradius_mysqlsource',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'icradius_secrets',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add <i>sqlradius</i> exports to <a href="../browse/part_svc">Service definitions</a> instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'invoice_from',
+ 'section' => 'required',
+ 'description' => 'Return address on email invoices',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'invoice_template',
+ 'section' => 'required',
+ 'description' => 'Required template file for invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'lpr',
+ 'section' => 'required',
+ 'description' => 'Print command for paper invoices, for example `lpr -h\'',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'maildisablecatchall',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, now the default. Turning this option on used to disable the requirement that each virtual domain have a catch-all mailbox.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'money_char',
+ 'section' => '',
+ 'description' => 'Currency symbol - defaults to `$\'',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'mxmachines',
+ 'section' => 'deprecated',
+ 'description' => 'MX entries for new domains, weight and machine, one per line, with trailing `.\'',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'nsmachines',
+ 'section' => 'deprecated',
+ 'description' => 'NS nameservers for new domains, one per line, with trailing `.\'',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'defaultrecords',
+ 'section' => 'BIND',
+ 'description' => 'DNS entries to add automatically when creating a domain',
+ 'type' => 'editlist',
+ 'editlist_parts' => [ { type=>'text' },
+ { type=>'immutable', value=>'IN' },
+ { type=>'select',
+ select_enum=>{ map { $_=>$_ } qw(A CNAME MX NS)} },
+ { type=> 'text' }, ],
+ },
+
+ {
+ 'key' => 'arecords',
+ 'section' => 'deprecated',
+ 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'cnamerecords',
+ 'section' => 'deprecated',
+ 'description' => 'A list of tab seperated CNAME records to add automatically when creating a domain',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'nismachines',
+ 'section' => 'shell',
+ 'description' => 'Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'passwordmin',
+ 'section' => 'password',
+ 'description' => 'Minimum password length (default 6)',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'passwordmax',
+ 'section' => 'password',
+ 'description' => 'Maximum password length (default 8) (don\'t set this over 12 if you need to import or export crypt() passwords)',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'qmailmachines',
+ 'section' => 'mail',
+ 'description' => 'Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the <b>shellmachine</b> option.',
+ 'type' => [qw( checkbox textarea )],
+ },
+
+ {
+ 'key' => 'radiusmachines',
+ 'section' => 'radius',
+ 'description' => 'Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'referraldefault',
+ 'section' => 'UI',
+ 'description' => 'Default referral, specified by refnum',
+ 'type' => 'text',
+ },
+
+# {
+# 'key' => 'registries',
+# 'section' => 'required',
+# 'description' => 'Directory which contains domain registry information. Each registry is a directory.',
+# },
+
+ {
+ 'key' => 'report_template',
+ 'section' => 'required',
+ 'description' => 'Required template file for reports. See the <a href="../docs/billing.html">billing documentation</a> for details.',
+ 'type' => 'textarea',
+ },
+
+
+ {
+ 'key' => 'maxsearchrecordsperpage',
+ 'section' => 'UI',
+ 'description' => 'If set, number of search records to return per page.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'sendmailconfigpath',
+ 'section' => 'mail',
+ 'description' => 'Sendmail configuration file path. Defaults to `/etc\'. Many newer distributions use `/etc/mail\'.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'sendmailmachines',
+ 'section' => 'mail',
+ 'description' => 'Your sendmail machines, one per line. This enables export of `/etc/virtusertable\' and `/etc/sendmail.cw\'.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'sendmailrestart',
+ 'section' => 'mail',
+ 'description' => 'If defined, the command which is run on sendmail machines after files are copied.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'session-start',
+ 'section' => 'session',
+ 'description' => 'If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'session-stop',
+ 'section' => 'session',
+ 'description' => 'If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'shellmachine',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain 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.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'shellmachine-useradd',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is created. If the <b>shellmachine</b> option is set but this option is not, <code>useradd -d $dir -m -s $shell -u $uid $username</code> is the default. If this option is set but empty, <code>cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</code> is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: <code>$username</code>, <code>$uid</code>, <code>$gid</code>, <code>$dir</code>, and <code>$shell</code>.',
+ 'type' => [qw( checkbox text )],
+ },
+
+ {
+ 'key' => 'shellmachine-userdel',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is deleted. If the <b>shellmachine</b> option is set but this option is not, <code>userdel $username</code> is the default. If this option is set but empty, <code>rm -rf $dir</code> is the default instead. Otherwise the value is evaluated as a double-quoted perl string, with the following variables available: <code>$username</code> and <code>$dir</code>.',
+ 'type' => [qw( checkbox text )],
+ },
+
+ {
+ 'key' => 'shellmachine-usermod',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain command(s) to run on shellmachine when an account is modified. If the <b>shellmachine</b> option is set but this option is empty, <code>[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir )</code> is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$old_dir</code>, <code>$new_dir</code>, <code>$uid</code> and <code>$gid</code>.',
+ #'type' => [qw( checkbox text )],
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'shellmachines',
+ 'section' => 'shell',
+ 'description' => 'Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'shells',
+ 'section' => 'required',
+ 'description' => 'Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq\' initially so that importing doesn\'t fail with `Illegal shell\' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'showpasswords',
+ 'section' => 'UI',
+ 'description' => 'Display unencrypted user passwords in the web interface',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'signupurl',
+ 'section' => 'UI',
+ 'description' => 'if you are using customer-to-customer referrals, and you enter the URL of your <a href="../docs/signup.html">signup server CGI</a>, the customer view screen will display a customized link to the signup server with the appropriate customer as referral',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'smtpmachine',
+ 'section' => 'required',
+ 'description' => 'SMTP relay for Freeside\'s outgoing mail',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'soadefaultttl',
+ 'section' => 'BIND',
+ 'description' => 'SOA default TTL for new domains.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'soaemail',
+ 'section' => 'BIND',
+ 'description' => 'SOA email for new domains, in BIND form (`.\' instead of `@\'), with trailing `.\'',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'soaexpire',
+ 'section' => 'BIND',
+ 'description' => 'SOA expire for new domains',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'soamachine',
+ 'section' => 'BIND',
+ 'description' => 'SOA machine for new domains, with trailing `.\'',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'soarefresh',
+ 'section' => 'BIND',
+ 'description' => 'SOA refresh for new domains',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'soaretry',
+ 'section' => 'BIND',
+ 'description' => 'SOA retry for new domains',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'statedefault',
+ 'section' => 'UI',
+ 'description' => 'Default state or province (if not supplied, the default is `CA\')',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'radiusprepend',
+ 'section' => 'radius',
+ 'description' => 'The contents will be prepended to the top of the RADIUS users file (text exports only).',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'textradiusprepend',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, use RADIUS check attributes instead. This option will be removed soon. The contents will be prepended to the first line of a user\'s RADIUS entry in text exports.',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'unsuspendauto',
+ 'section' => 'billing',
+ 'description' => 'Enables the automatic unsuspension of suspended packages when a customer\'s balance due changes from positive to zero or negative as the result of a payment or credit',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'usernamemin',
+ 'section' => 'username',
+ 'description' => 'Minimum username length (default 2)',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'usernamemax',
+ 'section' => 'username',
+ 'description' => 'Maximum username length',
+ 'type' => 'text',
+ },
+
+ {
+ 'key' => 'username-ampersand',
+ 'section' => 'username',
+ 'description' => 'Allow the ampersand character (&) in usernames. Be careful when using this option in conjunction with <a href="#shellmachine-useradd">shellmachine-useradd</a> and other configuration options which execute shell commands, as the ampersand will be interpreted by the shell if not quoted.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username-letter',
+ 'section' => 'username',
+ 'description' => 'Usernames must contain at least one letter',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username-letterfirst',
+ 'section' => 'username',
+ 'description' => 'Usernames must start with a letter',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username-noperiod',
+ 'section' => 'username',
+ 'description' => 'Disallow periods in usernames',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username-nounderscore',
+ 'section' => 'username',
+ 'description' => 'Disallow underscores in usernames',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username-nodash',
+ 'section' => 'username',
+ 'description' => 'Disallow dashes in usernames',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username-uppercase',
+ 'section' => 'username',
+ 'description' => 'Allow uppercase characters in usernames',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'username_policy',
+ 'section' => '',
+ 'description' => 'This file controls the mechanism for preventing duplicate usernames in passwd/radius files exported from svc_accts. This should be one of \'prepend domsvc\' \'append domsvc\' \'append domain\' or \'append @domain\'',
+ 'type' => 'select',
+ 'select_enum' => [ 'prepend domsvc', 'append domsvc', 'append domain', 'append @domain' ],
+ #'type' => 'text',
+ },
+
+ {
+ 'key' => 'vpopmailmachines',
+ 'section' => 'deprecated',
+ 'description' => '<b>DEPRECATED</b>, add a <i>cp</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to contain your vpopmail pop toasters, one per line. Each line is of the form "machinename vpopdir vpopuid vpopgid". For example: <code>poptoaster.domain.tld /home/vpopmail 508 508</code> Note: vpopuid and vpopgid are values taken from the vpopmail machine\'s /etc/passwd',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'vpopmailrestart',
+ 'section' => 'mail',
+ 'description' => 'If defined, the shell commands to run on vpopmail machines after files are copied. An example can be found in eg/vpopmailrestart of the source distribution.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'safe-part_pkg',
+ 'section' => 'UI',
+ 'description' => 'Validates package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'safe-part_bill_event',
+ 'section' => 'UI',
+ 'description' => 'Validates invoice event expressions against a preset list. Useful for webdemos, annoying to powerusers.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'show_ss',
+ 'section' => 'UI',
+ 'description' => 'Turns on display/collection of SS# in the web interface.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'agent_defaultpkg',
+ 'section' => 'UI',
+ 'description' => 'Setting this option will cause new packages to be available to all agent types by default.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'legacy_link',
+ 'section' => 'UI',
+ 'description' => 'Display options in the web interface to link legacy pre-Freeside services.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'queue_dangerous_controls',
+ 'section' => 'UI',
+ 'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'security_phrase',
+ 'section' => 'password',
+ 'description' => 'Enable the tracking of a "security phrase" with each account. Not recommended, as it is vulnerable to social engineering.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'locale',
+ 'section' => 'UI',
+ 'description' => 'Message locale',
+ 'type' => 'select',
+ 'select_enum' => [ qw(en_US) ],
+ },
+
+ {
+ 'key' => 'signup_server-payby',
+ 'section' => '',
+ 'description' => 'Acceptable payment types for the signup server',
+ 'type' => 'selectmultiple',
+ 'select_enum' => [ qw(CARD PREPAY BILL COMP) ],
+ },
+
+ {
+ 'key' => 'signup_server-email',
+ 'section' => '',
+ 'description' => 'Comma-separated list of email addresses to receive notification of signups via the signup server.',
+ 'type' => 'text',
+ },
+
+
+ {
+ 'key' => 'show-msgcat-codes',
+ 'section' => 'UI',
+ 'description' => 'Show msgcat codes in error messages. Turn this option on before reporting errors to the mailing list.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'signup_server-realtime',
+ 'section' => '',
+ 'description' => 'Run billing for signup server signups immediately, and suspend accounts which subsequently have a balance.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'declinetemplate',
+ 'section' => 'billing',
+ 'description' => 'Template file for credit card decline emails.',
+ 'type' => 'textarea',
+ },
+
+ {
+ 'key' => 'emaildecline',
+ 'section' => 'billing',
+ 'description' => 'Enable emailing of credit card decline notices.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'require_cardname',
+ 'section' => 'billing',
+ 'description' => 'Require an "Exact name on card" to be entered explicitly; don\'t default to using the first and last name.',
+ 'type' => 'checkbox',
+ },
+
+ {
+ 'key' => 'enable_taxclasses',
+ 'section' => 'billing',
+ 'description' => 'Enable per-package tax classes',
+ 'type' => 'checkbox',
+ },
+
+);
+
+1;
+
--- /dev/null
+package FS::ConfItem;
+
+=head1 NAME
+
+FS::ConfItem - Configutaion option meta-data.
+
+=head1 SYNOPSIS
+
+ use FS::Conf;
+ @config_items = $conf->config_items;
+
+ foreach $item ( @config_items ) {
+ $key = $item->key;
+ $section = $item->section;
+ $description = $item->description;
+ }
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = @_ ? shift : {};
+ bless ($self, $class);
+}
+
+=item key
+
+=item section
+
+=item description
+
+=cut
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $field = $AUTOLOAD;
+ $field =~ s/.*://;
+ $self->{$field};
+}
+
+=back
+
+=head1 BUGS
+
+Terse docs.
+
+=head1 SEE ALSO
+
+L<FS::Conf>
+
+=cut
+
+1;
+
--- /dev/null
+package FS::Msgcat;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK $conf $locale $debug );
+use Exporter;
+use FS::UID;
+#use FS::Record qw( qsearchs ); # wtf? won't import...
+use FS::Record;
+use FS::Conf;
+use FS::msgcat;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw( gettext geterror );
+
+$FS::UID::callback{'Msgcat'} = sub {
+ $conf = new FS::Conf;
+ $locale = $conf->config('locale') || 'en_US';
+ $debug = $conf->exists('show-msgcat-codes')
+};
+
+=head1 NAME
+
+FS::Msgcat - Message catalog functions
+
+=head1 SYNOPSIS
+
+ use FS::Msgcat qw(gettext geterror);
+
+ #simple interface for retreiving messages...
+ $message = gettext('msgcode');
+ #or errors (includes the error code)
+ $message = geterror('msgcode');
+
+=head1 DESCRIPTION
+
+FS::Msgcat provides functions to use the message catalog. If you want to
+maintain the message catalog database, see L<FS::msgcat> instead.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item gettext MSGCODE
+
+Returns the full message for the supplied message code.
+
+=cut
+
+sub gettext {
+ $debug ? geterror(@_) : _gettext(@_);
+}
+
+sub _gettext {
+ my $msgcode = shift;
+ my $msgcat = FS::Record::qsearchs('msgcat', {
+ 'msgcode' => $msgcode,
+ 'locale' => $locale
+ } );
+ if ( $msgcat ) {
+ $msgcat->msg;
+ } else {
+ warn "WARNING: message for msgcode $msgcode in locale $locale not found";
+ $msgcode;
+ }
+
+}
+
+=item geterror MSGCODE
+
+Returns the full message for the supplied message code, including the message
+code.
+
+=cut
+
+sub geterror {
+ my $msgcode = shift;
+ my $msg = _gettext($msgcode);
+ if ( $msg eq $msgcode ) {
+ "Error code $msgcode (message for locale $locale not found)";
+ } else {
+ "$msg (error code $msgcode)";
+ }
+}
+
+=back
+
+=head1 BUGS
+
+i18n/l10n, eek
+
+=head1 SEE ALSO
+
+L<FS::msgcat>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::Record;
+
+use strict;
+use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
+ $me );
+use subs qw(reload_dbdef);
+use Exporter;
+use Carp qw(carp cluck croak confess);
+use File::CounterFile;
+use Locale::Country;
+use DBI qw(:sql_types);
+use DBIx::DBSchema 0.19;
+use FS::UID qw(dbh checkruid getotaker datasrc driver_name);
+use FS::SearchCache;
+use FS::Msgcat qw(gettext);
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch);
+
+$DEBUG = 0;
+$me = '[FS::Record]';
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::Record'} = sub {
+ $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
+ $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
+ &reload_dbdef unless $setup_hack; #$setup_hack needed now?
+};
+
+=head1 NAME
+
+FS::Record - Database record objects
+
+=head1 SYNOPSIS
+
+ use FS::Record;
+ use FS::Record qw(dbh fields qsearch qsearchs dbdef);
+
+ $record = new FS::Record 'table', \%hash;
+ $record = new FS::Record 'table', { 'column' => 'value', ... };
+
+ $record = qsearchs FS::Record 'table', \%hash;
+ $record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
+ @records = qsearch FS::Record 'table', \%hash;
+ @records = qsearch FS::Record 'table', { 'column' => 'value', ... };
+
+ $table = $record->table;
+ $dbdef_table = $record->dbdef_table;
+
+ $value = $record->get('column');
+ $value = $record->getfield('column');
+ $value = $record->column;
+
+ $record->set( 'column' => 'value' );
+ $record->setfield( 'column' => 'value' );
+ $record->column('value');
+
+ %hash = $record->hash;
+
+ $hashref = $record->hashref;
+
+ $error = $record->insert;
+ #$error = $record->add; #deprecated
+
+ $error = $record->delete;
+ #$error = $record->del; #deprecated
+
+ $error = $new_record->replace($old_record);
+ #$error = $new_record->rep($old_record); #deprecated
+
+ $value = $record->unique('column');
+
+ $error = $record->ut_float('column');
+ $error = $record->ut_number('column');
+ $error = $record->ut_numbern('column');
+ $error = $record->ut_money('column');
+ $error = $record->ut_text('column');
+ $error = $record->ut_textn('column');
+ $error = $record->ut_alpha('column');
+ $error = $record->ut_alphan('column');
+ $error = $record->ut_phonen('column');
+ $error = $record->ut_anything('column');
+ $error = $record->ut_name('column');
+
+ $dbdef = reload_dbdef;
+ $dbdef = reload_dbdef "/non/standard/filename";
+ $dbdef = dbdef;
+
+ $quoted_value = _quote($value,'table','field');
+
+ #depriciated
+ $fields = hfields('table');
+ if ( $fields->{Field} ) { # etc.
+
+ @fields = fields 'table'; #as a subroutine
+ @fields = $record->fields; #as a method call
+
+
+=head1 DESCRIPTION
+
+(Mostly) object-oriented interface to database records. Records are currently
+implemented on top of DBI. FS::Record is intended as a base class for
+table-specific classes to inherit from, i.e. FS::cust_main.
+
+=head1 CONSTRUCTORS
+
+=over 4
+
+=item new [ TABLE, ] HASHREF
+
+Creates a new record. It doesn't store it in the database, though. See
+L<"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 I<hash>
+method.
+
+TABLE can only be omitted when a dervived class overrides the table method.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+
+ unless ( defined ( $self->table ) ) {
+ $self->{'Table'} = shift;
+ carp "warning: FS::Record::new called with table name ". $self->{'Table'};
+ }
+
+ my $hashref = $self->{'Hash'} = shift;
+
+ foreach my $field ( $self->fields ) {
+ $hashref->{$field}='' unless defined $hashref->{$field};
+ #trim the '$' and ',' from money fields for Pg (belong HERE?)
+ #(what about Pg i18n?)
+ if ( driver_name =~ /^Pg$/i
+ && $self->dbdef_table->column($field)->type eq 'money' ) {
+ ${$hashref}{$field} =~ s/^\$//;
+ ${$hashref}{$field} =~ s/\,//;
+ }
+ }
+
+ $self->_cache($hashref, shift) if $self->can('_cache') && @_;
+
+ $self;
+}
+
+sub new_or_cached {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+
+ $self->{'Table'} = shift unless defined ( $self->table );
+
+ my $hashref = $self->{'Hash'} = shift;
+ my $cache = shift;
+ if ( defined( $cache->cache->{$hashref->{$cache->key}} ) ) {
+ my $obj = $cache->cache->{$hashref->{$cache->key}};
+ $obj->_cache($hashref, $cache) if $obj->can('_cache');
+ $obj;
+ } else {
+ $cache->cache->{$hashref->{$cache->key}} = $self->new($hashref, $cache);
+ }
+
+}
+
+sub create {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+ if ( defined $self->table ) {
+ cluck "create constructor is depriciated, use new!";
+ $self->new(@_);
+ } else {
+ croak "FS::Record::create called (not from a subclass)!";
+ }
+}
+
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ
+
+Searches the database for all records matching (at least) the key/value pairs
+in HASHREF. Returns all the records found as `FS::TABLE' objects if that
+module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record
+objects.
+
+###oops, argh, FS::Record::new only lets us create database fields.
+#Normal behaviour if SELECT is not specified is `*', as in
+#C<SELECT * FROM table WHERE ...>. However, there is an experimental new
+#feature where you can specify SELECT - remember, the objects returned,
+#although blessed into the appropriate `FS::TABLE' package, will only have the
+#fields you specify. This might have unwanted results if you then go calling
+#regular FS::TABLE methods
+#on it.
+
+=cut
+
+sub qsearch {
+ my($stable, $record, $select, $extra_sql, $cache ) = @_;
+ #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
+ #for jsearch
+ $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
+ $stable = $1;
+ $select ||= '*';
+ my $dbh = dbh;
+
+ my $table = $cache ? $cache->table : $stable;
+
+ my @fields = grep exists($record->{$_}), fields($table);
+
+ my $statement = "SELECT $select FROM $stable";
+ if ( @fields ) {
+ $statement .= ' WHERE '. join(' AND ', map {
+
+ my $op = '=';
+ if ( ref($record->{$_}) ) {
+ $op = $record->{$_}{'op'} if $record->{$_}{'op'};
+ $op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i;
+ $record->{$_} = $record->{$_}{'value'}
+ }
+
+ if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
+ if ( $op eq '=' ) {
+ if ( driver_name =~ /^Pg$/i ) {
+ qq-( $_ IS NULL OR $_ = '' )-;
+ } else {
+ qq-( $_ IS NULL OR $_ = "" )-;
+ }
+ } elsif ( $op eq '!=' ) {
+ if ( driver_name =~ /^Pg$/i ) {
+ qq-( $_ IS NOT NULL AND $_ != '' )-;
+ } else {
+ qq-( $_ IS NOT NULL AND $_ != "" )-;
+ }
+ } else {
+ if ( driver_name =~ /^Pg$/i ) {
+ qq-( $_ $op '' )-;
+ } else {
+ qq-( $_ $op "" )-;
+ }
+ }
+ } else {
+ "$_ $op ?";
+ }
+ } @fields );
+ }
+ $statement .= " $extra_sql" if defined($extra_sql);
+
+ warn "[debug]$me $statement\n" if $DEBUG;
+ my $sth = $dbh->prepare($statement)
+ or croak "$dbh->errstr doing $statement";
+
+ my $bind = 1;
+
+ foreach my $field (
+ grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+ ) {
+ if ( $record->{$field} =~ /^\d+(\.\d+)?$/
+ && $dbdef->table($table)->column($field)->type =~ /(int)/i
+ ) {
+ $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_INTEGER } );
+ } else {
+ $sth->bind_param($bind++, $record->{$field}, { TYPE => SQL_VARCHAR } );
+ }
+ }
+
+# $sth->execute( map $record->{$_},
+# grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+# ) or croak "Error executing \"$statement\": ". $sth->errstr;
+
+ $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr;
+
+ $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
+
+ if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
+ if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
+ #derivied class didn't override new method, so this optimization is safe
+ if ( $cache ) {
+ map {
+ new_or_cached( "FS::$table", { %{$_} }, $cache )
+ } @{$sth->fetchall_arrayref( {} )};
+ } else {
+ map {
+ new( "FS::$table", { %{$_} } )
+ } @{$sth->fetchall_arrayref( {} )};
+ }
+ } else {
+ warn "untested code (class FS::$table uses custom new method)";
+ map {
+ eval 'FS::'. $table. '->new( { %{$_} } )';
+ } @{$sth->fetchall_arrayref( {} )};
+ }
+ } else {
+ cluck "warning: FS::$table not loaded; returning FS::Record objects";
+ map {
+ FS::Record->new( $table, { %{$_} } );
+ } @{$sth->fetchall_arrayref( {} )};
+ }
+
+}
+
+=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
+
+Experimental JOINed search method. Using this method, you can execute a
+single SELECT spanning multiple tables, and cache the results for subsequent
+method calls. Interface will almost definately change in an incompatible
+fashion.
+
+Arguments:
+
+=cut
+
+sub jsearch {
+ my($table, $record, $select, $extra_sql, $ptable, $pkey ) = @_;
+ my $cache = FS::SearchCache->new( $ptable, $pkey );
+ my %saw;
+ ( $cache,
+ grep { !$saw{$_->getfield($pkey)}++ }
+ qsearch($table, $record, $select, $extra_sql, $cache )
+ );
+}
+
+=item qsearchs TABLE, HASHREF
+
+Same as qsearch, except that if more than one record matches, it B<carp>s but
+returns the first. If this happens, you either made a logic error in asking
+for a single item, or your data is corrupted.
+
+=cut
+
+sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
+ my(@result) = qsearch(@_);
+ carp "warning: Multiple records in scalar search!" if scalar(@result) > 1;
+ #should warn more vehemently if the search was on a primary key?
+ scalar(@result) ? ($result[0]) : ();
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item table
+
+Returns the table name.
+
+=cut
+
+sub table {
+# cluck "warning: FS::Record::table depriciated; supply one in subclass!";
+ my $self = shift;
+ $self -> {'Table'};
+}
+
+=item dbdef_table
+
+Returns the DBIx::DBSchema::Table object for the table.
+
+=cut
+
+sub dbdef_table {
+ my($self)=@_;
+ my($table)=$self->table;
+ $dbdef->table($table);
+}
+
+=item get, getfield COLUMN
+
+Returns the value of the column/field/key COLUMN.
+
+=cut
+
+sub get {
+ my($self,$field) = @_;
+ # to avoid "Use of unitialized value" errors
+ if ( defined ( $self->{Hash}->{$field} ) ) {
+ $self->{Hash}->{$field};
+ } else {
+ '';
+ }
+}
+sub getfield {
+ my $self = shift;
+ $self->get(@_);
+}
+
+=item set, setfield COLUMN, VALUE
+
+Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE.
+
+=cut
+
+sub set {
+ my($self,$field,$value) = @_;
+ $self->{'Hash'}->{$field} = $value;
+}
+sub setfield {
+ my $self = shift;
+ $self->set(@_);
+}
+
+=item AUTLOADED METHODS
+
+$record->column is a synonym for $record->get('column');
+
+$record->column('value') is a synonym for $record->set('column','value');
+
+=cut
+
+# readable/safe
+sub AUTOLOAD {
+ my($self,$value)=@_;
+ my($field)=$AUTOLOAD;
+ $field =~ s/.*://;
+ if ( defined($value) ) {
+ confess "errant AUTOLOAD $field for $self (arg $value)"
+ unless $self->can('setfield');
+ $self->setfield($field,$value);
+ } else {
+ confess "errant AUTOLOAD $field for $self (no args)"
+ unless $self->can('getfield');
+ $self->getfield($field);
+ }
+}
+
+# efficient
+#sub AUTOLOAD {
+# my $field = $AUTOLOAD;
+# $field =~ s/.*://;
+# if ( defined($_[1]) ) {
+# $_[0]->setfield($field, $_[1]);
+# } else {
+# $_[0]->getfield($field);
+# }
+#}
+
+=item hash
+
+Returns a list of the column/value pairs, usually for assigning to a new hash.
+
+To make a distinct duplicate of an FS::Record object, you can do:
+
+ $new = new FS::Record ( $old->table, { $old->hash } );
+
+=cut
+
+sub hash {
+ my($self) = @_;
+ %{ $self->{'Hash'} };
+}
+
+=item hashref
+
+Returns a reference to the column/value hash.
+
+=cut
+
+sub hashref {
+ my($self) = @_;
+ $self->{'Hash'};
+}
+
+=item insert
+
+Inserts this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ #single-field unique keys are given a value if false
+ #(like MySQL's AUTO_INCREMENT)
+ foreach ( $self->dbdef_table->unique->singles ) {
+ $self->unique($_) unless $self->getfield($_);
+ }
+ #and also the primary key
+ my $primary_key = $self->dbdef_table->primary_key;
+ $self->unique($primary_key)
+ if $primary_key && ! $self->getfield($primary_key);
+
+ #false laziness w/delete
+ my @fields =
+ grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+ $self->fields
+ ;
+ my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
+ #eslaf
+
+ my $statement = "INSERT INTO ". $self->table. " ( ".
+ join( ', ', @fields ).
+ ") VALUES (".
+ join( ', ', @values ).
+ ")"
+ ;
+ warn "[debug]$me $statement\n" if $DEBUG;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
+
+ my $h_sth;
+ if ( defined $dbdef->table('h_'. $self->table) ) {
+ my $h_statement = $self->_h_statement('insert');
+ warn "[debug]$me $h_statement\n" if $DEBUG;
+ $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
+ } else {
+ $h_sth = '';
+ }
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ $sth->execute or return $sth->errstr;
+ $h_sth->execute or return $h_sth->errstr if $h_sth;
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
+
+ '';
+}
+
+=item add
+
+Depriciated (use insert instead).
+
+=cut
+
+sub add {
+ cluck "warning: FS::Record::add depriciated!";
+ insert @_; #call method in this scope
+}
+
+=item delete
+
+Delete this record from the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ my $statement = "DELETE FROM ". $self->table. " WHERE ". join(' AND ',
+ map {
+ $self->getfield($_) eq ''
+ #? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( driver_name =~ /^Pg$/i
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
+ : "$_ = ". _quote($self->getfield($_),$self->table,$_)
+ } ( $self->dbdef_table->primary_key )
+ ? ( $self->dbdef_table->primary_key)
+ : $self->fields
+ );
+ warn "[debug]$me $statement\n" if $DEBUG;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
+
+ my $h_sth;
+ if ( defined $dbdef->table('h_'. $self->table) ) {
+ my $h_statement = $self->_h_statement('delete');
+ warn "[debug]$me $h_statement\n" if $DEBUG;
+ $h_sth = dbh->prepare($h_statement) or return dbh->errstr;
+ } else {
+ $h_sth = '';
+ }
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $rc = $sth->execute or return $sth->errstr;
+ #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
+ $h_sth->execute or return $h_sth->errstr if $h_sth;
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
+
+ #no need to needlessly destoy the data either (causes problems actually)
+ #undef $self; #no need to keep object!
+
+ '';
+}
+
+=item del
+
+Depriciated (use delete instead).
+
+=cut
+
+sub del {
+ cluck "warning: FS::Record::del depriciated!";
+ &delete(@_); #call method in this scope
+}
+
+=item replace OLD_RECORD
+
+Replace the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ warn "[debug]$me $new ->replace $old\n" if $DEBUG;
+
+ return "Records not in same table!" unless $new->table eq $old->table;
+
+ my $primary_key = $old->dbdef_table->primary_key;
+ return "Can't change $primary_key"
+ if $primary_key
+ && ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
+
+ my $error = $new->check;
+ return $error if $error;
+
+ my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+ unless ( @diff ) {
+ carp "[warning]$me $new -> replace $old: records identical";
+ return '';
+ }
+
+ my $statement = "UPDATE ". $old->table. " SET ". join(', ',
+ map {
+ "$_ = ". _quote($new->getfield($_),$old->table,$_)
+ } @diff
+ ). ' WHERE '.
+ join(' AND ',
+ map {
+ $old->getfield($_) eq ''
+ #? "( $_ IS NULL OR $_ = \"\" )"
+ ? ( driver_name =~ /^Pg$/i
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
+ : "$_ = ". _quote($old->getfield($_),$old->table,$_)
+ } ( $primary_key ? ( $primary_key ) : $old->fields )
+ )
+ ;
+ warn "[debug]$me $statement\n" if $DEBUG;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
+
+ my $h_old_sth;
+ if ( defined $dbdef->table('h_'. $old->table) ) {
+ my $h_old_statement = $old->_h_statement('replace_old');
+ warn "[debug]$me $h_old_statement\n" if $DEBUG;
+ $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr;
+ } else {
+ $h_old_sth = '';
+ }
+
+ my $h_new_sth;
+ if ( defined $dbdef->table('h_'. $new->table) ) {
+ my $h_new_statement = $new->_h_statement('replace_new');
+ warn "[debug]$me $h_new_statement\n" if $DEBUG;
+ $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr;
+ } else {
+ $h_new_sth = '';
+ }
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $rc = $sth->execute or return $sth->errstr;
+ #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
+ $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth;
+ $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth;
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
+
+ '';
+
+}
+
+=item rep
+
+Depriciated (use replace instead).
+
+=cut
+
+sub rep {
+ cluck "warning: FS::Record::rep depriciated!";
+ replace @_; #call method in this scope
+}
+
+=item check
+
+Not yet implemented, croaks. Derived classes should provide a check method.
+
+=cut
+
+sub check {
+ confess "FS::Record::check not implemented; supply one in subclass!";
+}
+
+sub _h_statement {
+ my( $self, $action ) = @_;
+
+ my @fields =
+ grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+ $self->fields
+ ;
+ my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
+
+ "INSERT INTO h_". $self->table. " ( ".
+ join(', ', qw(history_date history_user history_action), @fields ).
+ ") VALUES (".
+ join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values).
+ ")"
+ ;
+}
+
+=item unique COLUMN
+
+Replaces COLUMN in record with a unique number. Called by the B<add> method
+on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>).
+Returns the new value.
+
+=cut
+
+sub unique {
+ my($self,$field) = @_;
+ my($table)=$self->table;
+
+ croak("&FS::UID::checkruid failed") unless &checkruid;
+
+ croak "Unique called on field $field, but it is ",
+ $self->getfield($field),
+ ", not null!"
+ if $self->getfield($field);
+
+ #warn "table $table is tainted" if is_tainted($table);
+ #warn "field $field is tainted" if is_tainted($field);
+
+ my($counter) = new File::CounterFile "$table.$field",0;
+# hack for web demo
+# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
+# my($user)=$1;
+# my($counter) = new File::CounterFile "$user/$table.$field",0;
+# endhack
+
+ my($index)=$counter->inc;
+ $index=$counter->inc
+ while qsearchs($table,{$field=>$index}); #just in case
+
+ $index =~ /^(\d*)$/;
+ $index=$1;
+
+ $self->setfield($field,$index);
+
+}
+
+=item ut_float COLUMN
+
+Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May not be
+null. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_float {
+ my($self,$field)=@_ ;
+ ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
+ $self->getfield($field) =~ /^(\d+)$/ ||
+ $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
+ $self->getfield($field) =~ /^(\d+e\d+)$/)
+ or return "Illegal or empty (float) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_number COLUMN
+
+Check/untaint simple numeric data (whole numbers). May not be null. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_number {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^(\d+)$/
+ or return "Illegal or empty (numeric) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_numbern COLUMN
+
+Check/untaint simple numeric data (whole numbers). May be null. If there is
+an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_numbern {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^(\d*)$/
+ or return "Illegal (numeric) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_money COLUMN
+
+Check/untaint monetary numbers. May be negative. Set to 0 if null. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_money {
+ my($self,$field)=@_;
+ $self->setfield($field, 0) if $self->getfield($field) eq '';
+ $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
+ or return "Illegal (money) $field: ". $self->getfield($field);
+ #$self->setfield($field, "$1$2$3" || 0);
+ $self->setfield($field, ( ($1||''). ($2||''). ($3||'') ) || 0);
+ '';
+}
+
+=item ut_text COLUMN
+
+Check/untaint text. Alphanumerics, spaces, and the following punctuation
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? / =
+May not be null. If there is an error, returns the error, otherwise returns
+false.
+
+=cut
+
+sub ut_text {
+ my($self,$field)=@_;
+ #warn "msgcat ". \&msgcat. "\n";
+ #warn "notexist ". \¬exist. "\n";
+ #warn "AUTOLOAD ". \&AUTOLOAD. "\n";
+ $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]+)$/
+ or return gettext('illegal_or_empty_text'). " $field: ".
+ $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_textn COLUMN
+
+Check/untaint text. Alphanumerics, spaces, and the following punctuation
+symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
+May be null. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_textn {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+ or return gettext('illegal_text'). " $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_alpha COLUMN
+
+Check/untaint alphanumeric strings (no spaces). May not be null. If there is
+an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_alpha {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^(\w+)$/
+ or return "Illegal or empty (alphanumeric) $field: ".
+ $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_alpha COLUMN
+
+Check/untaint alphanumeric strings (no spaces). May be null. If there is an
+error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_alphan {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^(\w*)$/
+ or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_phonen COLUMN [ COUNTRY ]
+
+Check/untaint phone numbers. May be null. If there is an error, returns
+the error, otherwise returns false.
+
+Takes an optional two-letter ISO country code; without it or with unsupported
+countries, ut_phonen simply calls ut_alphan.
+
+=cut
+
+sub ut_phonen {
+ my( $self, $field, $country ) = @_;
+ return $self->ut_alphan($field) unless defined $country;
+ my $phonen = $self->getfield($field);
+ if ( $phonen eq '' ) {
+ $self->setfield($field,'');
+ } elsif ( $country eq 'US' || $country eq 'CA' ) {
+ $phonen =~ s/\D//g;
+ $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
+ or return gettext('illegal_phone'). " $field: ". $self->getfield($field);
+ $phonen = "$1-$2-$3";
+ $phonen .= " x$4" if $4;
+ $self->setfield($field,$phonen);
+ } else {
+ warn "warning: don't know how to check phone numbers for country $country";
+ return $self->ut_textn($field);
+ }
+ '';
+}
+
+=item ut_ip COLUMN
+
+Check/untaint ip addresses. IPv4 only for now.
+
+=cut
+
+sub ut_ip {
+ my( $self, $field ) = @_;
+ $self->getfield($field) =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
+ or return "Illegal (IP address) $field: ". $self->getfield($field);
+ for ( $1, $2, $3, $4 ) { return "Illegal (IP address) $field" if $_ > 255; }
+ $self->setfield($field, "$1.$2.$3.$3");
+ '';
+}
+
+=item ut_ipn COLUMN
+
+Check/untaint ip addresses. IPv4 only for now. May be null.
+
+=cut
+
+sub ut_ipn {
+ my( $self, $field ) = @_;
+ if ( $self->getfield($field) =~ /^()$/ ) {
+ $self->setfield($field,'');
+ '';
+ } else {
+ $self->ut_ip($field);
+ }
+}
+
+=item ut_domain COLUMN
+
+Check/untaint host and domain names.
+
+=cut
+
+sub ut_domain {
+ my( $self, $field ) = @_;
+ #$self->getfield($field) =~/^(\w+\.)*\w+$/
+ $self->getfield($field) =~/^(([\w\-]+\.)*\w+)$/
+ or return "Illegal (domain) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_name COLUMN
+
+Check/untaint proper names; allows alphanumerics, spaces and the following
+punctuation: , . - '
+
+May not be null.
+
+=cut
+
+sub ut_name {
+ my( $self, $field ) = @_;
+ $self->getfield($field) =~ /^([\w \,\.\-\']+)$/
+ or return gettext('illegal_name'). " $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_zip COLUMN
+
+Check/untaint zip codes.
+
+=cut
+
+sub ut_zip {
+ my( $self, $field, $country ) = @_;
+ if ( $country eq 'US' ) {
+ $self->getfield($field) =~ /\s*(\d{5}(\-\d{4})?)\s*$/
+ or return gettext('illegal_zip'). " $field for country $country: ".
+ $self->getfield($field);
+ $self->setfield($field,$1);
+ } else {
+ $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+ or return gettext('illegal_zip'). " $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ }
+ '';
+}
+
+=item ut_country COLUMN
+
+Check/untaint country codes. Country names are changed to codes, if possible -
+see L<Locale::Country>.
+
+=cut
+
+sub ut_country {
+ my( $self, $field ) = @_;
+ unless ( $self->getfield($field) =~ /^(\w\w)$/ ) {
+ if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/
+ && country2code($1) ) {
+ $self->setfield($field,uc(country2code($1)));
+ }
+ }
+ $self->getfield($field) =~ /^(\w\w)$/
+ or return "Illegal (country) $field: ". $self->getfield($field);
+ $self->setfield($field,uc($1));
+ '';
+}
+
+=item ut_anything COLUMN
+
+Untaints arbitrary data. Be careful.
+
+=cut
+
+sub ut_anything {
+ my( $self, $field ) = @_;
+ $self->getfield($field) =~ /^(.*)$/s
+ or return "Illegal $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=item ut_enum COLUMN CHOICES_ARRAYREF
+
+Check/untaint a column, supplying all possible choices, like the "enum" type.
+
+=cut
+
+sub ut_enum {
+ my( $self, $field, $choices ) = @_;
+ foreach my $choice ( @$choices ) {
+ if ( $self->getfield($field) eq $choice ) {
+ $self->setfield($choice);
+ return '';
+ }
+ }
+ return "Illegal (enum) field $field: ". $self->getfield($field);
+}
+
+=item ut_foreign_key COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Check/untaint a foreign column key. Call a regular ut_ method (like ut_number)
+on the column first.
+
+=cut
+
+sub ut_foreign_key {
+ my( $self, $field, $table, $foreign ) = @_;
+ qsearchs($table, { $foreign => $self->getfield($field) })
+ or return "Can't find $field ". $self->getfield($field).
+ " in $table.$foreign";
+ '';
+}
+
+=item ut_foreign_keyn COLUMN FOREIGN_TABLE FOREIGN_COLUMN
+
+Like ut_foreign_key, except the null value is also allowed.
+
+=cut
+
+sub ut_foreign_keyn {
+ my( $self, $field, $table, $foreign ) = @_;
+ $self->getfield($field)
+ ? $self->ut_foreign_key($field, $table, $foreign)
+ : '';
+}
+
+=item 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 L<DBIx::DBSchema::Table>).
+
+=cut
+
+# Usage: @fields = fields($table);
+# @fields = $record->fields;
+sub fields {
+ my $something = shift;
+ my $table;
+ if ( ref($something) ) {
+ $table = $something->table;
+ } else {
+ $table = $something;
+ }
+ #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table;
+ my($table_obj) = $dbdef->table($table);
+ confess "Unknown table $table" unless $table_obj;
+ $table_obj->columns;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item reload_dbdef([FILENAME])
+
+Load a database definition (see L<DBIx::DBSchema>), optionally from a
+non-default filename. This command is executed at startup unless
+I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object.
+
+=cut
+
+sub reload_dbdef {
+ my $file = shift || $dbdef_file;
+ $dbdef = load DBIx::DBSchema $file
+ or die "can't load database schema from $file";
+}
+
+=item dbdef
+
+Returns the current database definition. See L<DBIx::DBSchema>.
+
+=cut
+
+sub dbdef { $dbdef; }
+
+=item _quote VALUE, TABLE, COLUMN
+
+This is an internal function used to construct SQL statements. It returns
+VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
+type (see L<DBIx::DBSchema::Column>) does not end in `char' or `binary'.
+
+=cut
+
+sub _quote {
+ my($value,$table,$field)=@_;
+ my($dbh)=dbh;
+ if ( $value =~ /^\d+(\.\d+)?$/ &&
+# ! ( datatype($table,$field) =~ /^char/ )
+ ! $dbdef->table($table)->column($field)->type =~ /(char|binary|text)$/i
+ ) {
+ $value;
+ } else {
+ $dbh->quote($value);
+ }
+}
+
+=item hfields TABLE
+
+This is depriciated. Don't use it.
+
+It returns a hash-type list with the fields of this record's table set true.
+
+=cut
+
+sub hfields {
+ carp "warning: hfields is depriciated";
+ my($table)=@_;
+ my(%hash);
+ foreach (fields($table)) {
+ $hash{$_}=1;
+ }
+ \%hash;
+}
+
+sub _dump {
+ my($self)=@_;
+ join("\n", map {
+ "$_: ". $self->getfield($_). "|"
+ } (fields($self->table)) );
+}
+
+sub DESTROY { return; }
+
+#sub DESTROY {
+# my $self = shift;
+# #use Carp qw(cluck);
+# #cluck "DESTROYING $self";
+# warn "DESTROYING $self";
+#}
+
+#sub is_tainted {
+# return ! eval { join('',@_), kill 0; 1; };
+# }
+
+=back
+
+=head1 BUGS
+
+This module should probably be renamed, since much of the functionality is
+of general use. It is not completely unlike Adapter::DBI (see below).
+
+Exported qsearch and qsearchs should be depriciated in favor of method calls
+(against an FS::Record object like the old search and searchs that qsearch
+and qsearchs were on top of.)
+
+The whole fields / hfields mess should be removed.
+
+The various WHERE clauses should be subroutined.
+
+table string should be depriciated in favor of DBIx::DBSchema::Table.
+
+No doubt we could benefit from a Tied hash. Documenting how exists / defined
+true maps to the database (and WHERE clauses) would also help.
+
+The ut_ methods should ask the dbdef for a default length.
+
+ut_sqltype (like ut_varchar) should all be defined
+
+A fallback check method should be provided which uses the dbdef.
+
+The ut_money method assumes money has two decimal digits.
+
+The Pg money kludge in the new method only strips `$'.
+
+The ut_phonen method only checks US-style phone numbers.
+
+The _quote function should probably use ut_float instead of a regex.
+
+All the subroutines probably should be methods, here or elsewhere.
+
+Probably should borrow/use some dbdef methods where appropriate (like sub
+fields)
+
+As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc,
+or allow it to be set. Working around it is ugly any way around - DBI should
+be fixed. (only affects RDBMS which return uppercase column names)
+
+ut_zip should take an optional country like ut_phone.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<FS::UID>, L<DBI>
+
+Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::SearchCache;
+
+use strict;
+use vars qw($DEBUG);
+#use Carp qw(carp cluck croak confess);
+
+$DEBUG = 0;
+
+=head1 NAME
+
+FS::SearchCache - cache
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my( $table, $key ) = @_;
+ warn "table $table\n" if $DEBUG > 1;
+ warn "key $key\n" if $DEBUG > 1;
+ my $self = { 'table' => $table,
+ 'key' => $key,
+ 'cache' => {},
+ 'subcache' => {},
+ };
+ bless ($self, $class);
+
+ $self;
+}
+
+=item table
+
+=cut
+
+sub table { my $self = shift; $self->{table}; }
+
+=item key
+
+=cut
+
+sub key { my $self = shift; $self->{key}; }
+
+=item cache
+
+=cut
+
+sub cache { my $self = shift; $self->{cache}; }
+
+=item subcache
+
+=cut
+
+sub subcache {
+ my $self = shift;
+ my $col = shift;
+ my $table = shift;
+ my $keyval = shift;
+ if ( exists $self->{subcache}->{$col}->{$keyval} ) {
+ warn "returning existing subcache for $keyval ($col)".
+ "$self->{subcache}->{$col}->{$keyval}\n" if $DEBUG;
+ return $self->{subcache}->{$col}->{$keyval};
+ } else {
+ #my $tablekey = @_ ? shift : $col;
+ my $tablekey = $col;
+ my $subcache = ref($self)->new( $table, $tablekey );
+ $self->{subcache}->{$col}->{$keyval} = $subcache;
+ warn "creating new subcache $table $tablekey: $subcache\n" if $DEBUG;
+ $subcache;
+ }
+}
+
+=back
+
+=head1 BUGS
+
+Dismal documentation.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>
+
+=cut
+
+1;
+
+
--- /dev/null
+package FS::UI::Base;
+
+use strict;
+use vars qw ( @ISA );
+use FS::Record qw( fields qsearch );
+
+@ISA = ( $FS::UI::Base::_lock );
+
+=head1 NAME
+
+FS::UI::Base - Base class for all user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::SomeInterface;
+ use FS::UI::some_table;
+
+ $interface = new FS::UI::some_table;
+
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;
+
+=head1 DESCRIPTION
+
+An FS::UI::Base object represents a user interface object. FS::UI::Base
+is intended as a base class for table-specfic classes to inherit from, i.e.
+FS::UI::cust_main. The simplest case, which will provide a default UI for your
+new table, is as follows:
+
+ package FS::UI::table_name;
+ use vars qw ( @ISA );
+ use FS::UI::Base;
+ @ISA = qw( FS::UI::Base );
+ sub db_table { 'table_name'; }
+
+Currently available interfaces are:
+ FS::UI::Gtk, an X-Windows UI implemented using the Gtk+ toolkit
+ FS::UI::CGI, a web interface implemented using CGI.pm, etc.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+=item browse
+
+=cut
+
+sub browse {
+ my $self = shift;
+
+ my @fields = $self->list_fields;
+
+ #begin browse-specific stuff
+
+ $self->title( "Browse ". $self->db_names ) unless $self->title;
+ my @records = qsearch ( $self->db_table, {} );
+
+ #end browse-specific stuff
+
+ $self->addwidget ( new FS::UI::_Text ( $self->db_description ) );
+
+ my @header = $self->list_header;
+ my @headerspan = $self->list_headerspan;
+ my %callback = $self->db_callback;
+
+ my $columns;
+
+ my $table = new FS::UI::_Tableborder (
+ 'rows' => 1 + scalar(@records),
+ 'columns' => $columns || scalar(@fields),
+ );
+
+ my $c = 0;
+ foreach my $header ( @header ) {
+ my $headerspan = shift(@headerspan) || 1;
+ $table->attach(
+ 0, $c, new FS::UI::_Text ( $header ), 1, $headerspan
+ );
+ $c += $headerspan;
+ }
+
+ my $r = 1;
+
+ foreach my $record ( @records ) {
+ $c = 0;
+ foreach my $field ( @fields ) {
+ my $value = $record->getfield($field);
+ my $widget;
+ if ( $callback{$field} ) {
+ $widget = &{ $callback{$field} }( $value, $record );
+ } else {
+ $widget = new FS::UI::_Text ( $value );
+ }
+ $table->attach( $r, $c++, $widget, 1, 1 );
+ }
+ $r++;
+ }
+
+ $self->addwidget( $table );
+
+ $self->activate;
+
+}
+
+=item title
+
+=cut
+
+sub title {
+ my $self = shift;
+ my $value = shift;
+ if ( defined($value) ) {
+ $self->{'title'} = $value;
+ } else {
+ $self->{'title'};
+ }
+}
+
+=item addwidget
+
+=cut
+
+sub addwidget {
+ my $self = shift;
+ my $widget = shift;
+ push @{ $self->{'Widgets'} }, $widget;
+}
+
+#fallback methods
+
+sub db_description {}
+
+sub db_name {}
+
+sub db_names {
+ my $self = shift;
+ $self->db_name. 's';
+}
+
+sub list_fields {
+ my $self = shift;
+ fields( $self->db_table );
+}
+
+sub list_header {
+ my $self = shift;
+ $self->list_fields
+}
+
+sub list_headerspan {
+ my $self = shift;
+ map 1, $self->list_header;
+}
+
+sub db_callback {}
+
+=back
+
+=head1 VERSION
+
+$Id: Base.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+There should be some sort of per-(freeside)-user preferences and the ability
+for specific FS::UI:: modules to put their own values there as well.
+
+=head1 SEE ALSO
+
+L<FS::UI::Gtk>, L<FS::UI::CGI>
+
+=head1 HISTORY
+
+$Log: Base.pm,v $
+Revision 1.1 1999-08-04 09:03:53 ivan
+initial checkin of module files for proper perl installation
+
+Revision 1.1 1999/01/20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::CGI;
+
+use strict;
+use CGI;
+#use CGI::Switch; #when FS::UID user and preference callback stuff is fixed
+use CGI::Carp qw(fatalsToBrowser);
+use HTML::Table;
+use FS::UID qw(adminsuidsetup);
+#use FS::Record qw( qsearch fields );
+
+die "Can't initialize CGI interface; $FS::UI::Base::_lock used"
+ if $FS::UI::Base::_lock;
+$FS::UI::Base::_lock = "FS::UI::CGI";
+
+=head1 NAME
+
+FS::UI::CGI - Base class for CGI user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::CGI;
+ use FS::UI::some_table;
+
+ $interface = new FS::UI::some_table;
+
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;
+
+=head1 DESCRIPTION
+
+An FS::UI::CGI object represents a CGI interface object.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+
+ $self->{'_cgi'} = new CGI;
+ $self->{'_user'} = $self->{'_cgi'}->remote_user;
+ $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
+
+ bless ( $self, $class);
+}
+
+sub activate {
+ my $self = shift;
+ print $self->_header,
+ join ( "<BR>", map $_->sprint, @{ $self->{'Widgets'} } ),
+ $self->_footer,
+ ;
+}
+
+=item _header
+
+=cut
+
+sub _header {
+ my $self = shift;
+ my $cgi = $self->{'_cgi'};
+
+ $cgi->header( '-expires' => 'now' ), '<HTML>',
+ '<HEAD><TITLE>', $self->title, '</TITLE></HEAD>',
+ '<BODY BGCOLOR="#ffffff">',
+ '<FONT COLOR="#ff0000" SIZE=7>', $self->title, '</FONT><BR><BR>',
+ ;
+}
+
+=item _footer
+
+=cut
+
+sub _footer {
+ "</BODY></HTML>";
+}
+
+=item interface
+
+Returns the string `CGI'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+
+=cut
+
+sub interface { 'CGI'; }
+
+=back
+
+=cut
+
+package FS::UI::_Widget;
+
+use vars qw( $AUTOLOAD );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ bless ( $self, $class );
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $value = shift;
+ my($field)=$AUTOLOAD;
+ $field =~ s/.*://;
+ if ( defined($value) ) {
+ $self->{$field} = $value;
+ } else {
+ $self->{$field};
+ }
+}
+
+package FS::UI::_Text;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ $self->{'_text'} = shift;
+ bless ( $self, $class );
+}
+
+sub sprint {
+ my $self = shift;
+ $self->{'_text'};
+}
+
+package FS::UI::_Link;
+
+use vars qw ( @ISA $BASE_URL );
+
+@ISA = qw ( FS::UI::_Widget);
+$BASE_URL = "http://rootwood.sisd.com/freeside";
+
+sub sprint {
+ my $self = shift;
+ my $table = $self->{'table'};
+ my $method = $self->{'method'};
+
+ # i will be cleaned up when we're done moving from the old webinterface!
+ my @arg = @{$self->{'arg'}};
+ my $yuck = join( "&", @arg);
+ qq(<A HREF="$BASE_URL/$method/$table.cgi?$yuck">). $self->{'text'}. "<\A>";
+}
+
+package FS::UI::_Table;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = $class eq $proto ? { @_ } : $proto;
+ bless ( $self, $class );
+ $self->{'_table'} = new HTML::Table ( $self->rows, $self->columns );
+ $self;
+}
+
+sub attach {
+ my $self = shift;
+ my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
+ $self->{"_table"}->setCell( $row+1, $column+1, $widget->sprint );
+ $self->{"_table"}->setCellRowSpan( $row+1, $column+1, $rowspan ) if $rowspan;
+ $self->{"_table"}->setCellColSpan( $row+1, $column+1, $colspan ) if $colspan;
+}
+
+sub sprint {
+ my $self = shift;
+ $self->{'_table'}->getTable;
+}
+
+package FS::UI::_Tableborder;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Table );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = $class eq $proto ? { @_ } : $proto;
+ bless ( $self, $class );
+ $self->SUPER::new(@_);
+ $self->{'_table'}->setBorder;
+ $self;
+}
+
+=head1 VERSION
+
+$Id: CGI.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+In _Tableborder, headers should be links that sort on their fields.
+
+_Link uses a constant $BASE_URL
+
+_Link passes the arguments as a manually-constructed GET string instead
+of POSTing, for compatability while the web interface is upgraded. Once
+this is done it should pass arguements properly (i.e. as a POST, 8-bit clean)
+
+Still some small bits of widget code same as FS::UI::Gtk.
+
+=head1 SEE ALSO
+
+L<FS::UI::Base>
+
+=head1 HISTORY
+
+$Log: CGI.pm,v $
+Revision 1.1 1999-08-04 09:03:53 ivan
+initial checkin of module files for proper perl installation
+
+Revision 1.1 1999/01/20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::Gtk;
+
+use strict;
+use Gtk;
+use FS::UID qw(adminsuidsetup);
+
+die "Can't initialize Gtk interface; $FS::UI::Base::_lock used"
+ if $FS::UI::Base::_lock;
+$FS::UI::Base::_lock = "FS::UI::Gtk";
+
+=head1 NAME
+
+FS::UI::Gtk - Base class for Gtk user-interface objects
+
+=head1 SYNOPSIS
+
+ use FS::UI::Gtk;
+ use FS::UI::some_table;
+
+ $interface = new FS::UI::some_table;
+
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;
+
+=head1 DESCRIPTION
+
+An FS::UI::Gtk object represents a Gtk user interface object.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+
+ bless ( $self, $class );
+
+ $self->{'_user'} = 'ivan'; #Pop up login window?
+ $self->{'_dbh'} = FS::UID::adminsuidsetup $self->{'_user'};
+
+
+
+ $self;
+}
+
+sub activate {
+ my $self = shift;
+
+ my $vbox = new Gtk::VBox ( 0, 4 );
+
+ foreach my $widget ( @{ $self->{'Widgets'} } ) {
+ $widget->_gtk->show;
+ $vbox->pack_start ( $widget->_gtk, 1, 1, 4 );
+ }
+ $vbox->show;
+
+ my $window = new Gtk::Window "toplevel";
+ $self->{'_gtk'} = $window;
+ $window->set_title( $self->title );
+ $window->add ( $vbox );
+ $window->show;
+ main Gtk;
+}
+
+=item interface
+
+Returns the string `Gtk'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+
+=cut
+
+sub interface { 'Gtk'; }
+
+=back
+
+=cut
+
+package FS::UI::_Widget;
+
+use vars qw( $AUTOLOAD );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ bless ( $self, $class );
+}
+
+sub _gtk {
+ my $self = shift;
+ $self->{'_gtk'};
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $value = shift;
+ my($field)=$AUTOLOAD;
+ $field =~ s/.*://;
+ if ( defined($value) ) {
+ $self->{$field} = $value;
+ } else {
+ $self->{$field};
+ }
+}
+
+package FS::UI::_Text;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ $self->{'_gtk'} = new Gtk::Label ( shift );
+ bless ( $self, $class );
+}
+
+package FS::UI::_Link;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ $self->{'_gtk'} = new_with_label Gtk::Button ( $self->{'text'} );
+ $self->{'_gtk'}->signal_connect( 'clicked', sub {
+ print "STUB: (Gtk) FS::UI::_Link";
+ }, "hi", "there" );
+ bless ( $self, $class );
+}
+
+
+package FS::UI::_Table;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Widget );
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = { @_ };
+ bless ( $self, $class );
+
+ $self->{'_gtk'} = new Gtk::Table (
+ $self->rows,
+ $self->columns,
+ 0, #homogeneous
+ );
+
+ $self;
+}
+
+sub attach {
+ my $self = shift;
+ my ( $row, $column, $widget, $rowspan, $colspan ) = @_;
+ $rowspan ||= 1;
+ $colspan ||= 1;
+ $self->_gtk->attach_defaults(
+ $widget->_gtk,
+ $column,
+ $column + $colspan,
+ $row,
+ $row + $rowspan,
+ );
+ $widget->_gtk->show;
+}
+
+package FS::UI::_Tableborder;
+
+use vars qw ( @ISA );
+
+@ISA = qw ( FS::UI::_Table );
+
+=head1 VERSION
+
+$Id: Gtk.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+This documentation is incomplete.
+
+_Tableborder is just a _Table now. _Tableborders should scroll (but not the
+headers) and need and need more decoration. (data in white section ala gtksql
+and sliding field widths) headers should be buttons that callback to sort on
+their fields.
+
+There should be a persistant, per-(freeside)-user store for window positions
+and sizes and sort fields etc (see L<FS::UI::CGI/BUGS>.
+
+Still some small bits of widget code same as FS::UI::CGI.
+
+=head1 SEE ALSO
+
+L<FS::UI::Base>
+
+=head1 HISTORY
+
+$Log: Gtk.pm,v $
+Revision 1.1 1999-08-04 09:03:53 ivan
+initial checkin of module files for proper perl installation
+
+Revision 1.1 1999/01/20 09:30:36 ivan
+skeletal cross-UI UI code.
+
+
+=cut
+
+1;
+
--- /dev/null
+package FS::UI::agent;
+
+use strict;
+use vars qw ( @ISA );
+use FS::UI::Base;
+use FS::Record qw( qsearchs );
+use FS::agent;
+use FS::agent_type;
+
+@ISA = qw ( FS::UI::Base );
+
+sub db_table { 'agent' };
+
+sub db_name { 'Agent' };
+
+sub db_description { <<END;
+Agents are resellers of your service. Agents may be limited to a subset of your
+full offerings (via their type).
+END
+}
+
+sub list_fields {
+ 'agentnum',
+ 'typenum',
+# 'freq',
+# 'prog',
+; }
+
+sub list_header {
+ 'Agent',
+ 'Type',
+# 'Freq (n/a)',
+# 'Prog (n/a)',
+; }
+
+sub db_callback {
+ 'agentnum' =>
+ sub {
+ my ( $agentnum, $record ) = @_;
+ my $agent = $record->agent;
+ new FS::UI::_Link (
+ 'table' => 'agent',
+ 'method' => 'edit',
+ 'arg' => [ $agentnum ],
+ 'text' => "$agentnum: $agent",
+ );
+ },
+ 'typenum' =>
+ sub {
+ my $typenum = shift;
+ my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
+ my $atype = $agent_type->atype;
+ new FS::UI::_Link (
+ 'table' => 'agent_type',
+ 'method' => 'edit',
+ 'arg' => [ $typenum ],
+ 'text' => "$typenum: $atype"
+ );
+ },
+}
+
+1;
--- /dev/null
+package FS::UID;
+
+use strict;
+use vars qw(
+ @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
+ $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
+ $AutoCommit
+);
+use subs qw(
+ getsecrets cgisetotaker
+);
+use Exporter;
+use Carp qw(carp croak cluck);
+use DBI;
+use FS::Conf;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
+ getotaker dbh datasrc getsecrets driver_name );
+
+$freeside_uid = scalar(getpwnam('freeside'));
+
+$conf_dir = "/usr/local/etc/freeside/";
+
+$AutoCommit = 1; #ours, not DBI
+
+=head1 NAME
+
+FS::UID - Subroutines for database login and assorted other stuff
+
+=head1 SYNOPSIS
+
+ use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
+ checkeuid checkruid);
+
+ adminsuidsetup $user;
+
+ $cgi = new CGI;
+ $dbh = cgisuidsetup($cgi);
+
+ $dbh = dbh;
+
+ $datasrc = datasrc;
+
+ $driver_name = driver_name;
+
+=head1 DESCRIPTION
+
+Provides a hodgepodge of subroutines.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item 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).
+
+=cut
+
+sub adminsuidsetup {
+ $dbh->disconnect if $dbh;
+ &forksuidsetup(@_);
+}
+
+sub forksuidsetup {
+ $user = shift;
+ croak "fatal: adminsuidsetup called without arguements" unless $user;
+
+ $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
+ $user = $1;
+
+ $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+ $ENV{'SHELL'} = '/bin/sh';
+ $ENV{'IFS'} = " \t\n";
+ $ENV{'CDPATH'} = '';
+ $ENV{'ENV'} = '';
+ $ENV{'BASH_ENV'} = '';
+
+ croak "Not running uid freeside!" unless checkeuid();
+ getsecrets;
+ $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
+ 'AutoCommit' => 0,
+ 'ChopBlanks' => 1,
+ } ) or die "DBI->connect error: $DBI::errstr\n";
+
+ foreach ( keys %callback ) {
+ &{$callback{$_}};
+ }
+
+ $dbh;
+}
+
+=item cgisuidsetup CGI_object
+
+Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
+object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
+
+=cut
+
+sub cgisuidsetup {
+ $cgi=shift;
+ if ( $cgi->isa('CGI::Base') ) {
+ carp "Use of CGI::Base is depriciated";
+ } elsif ( $cgi->isa('Apache') ) {
+
+ } elsif ( ! $cgi->isa('CGI') ) {
+ croak "fatal: unrecognized object $cgi";
+ }
+ cgisetotaker;
+ adminsuidsetup($user);
+}
+
+=item cgi
+
+Returns the CGI (see L<CGI>) object.
+
+=cut
+
+sub cgi {
+ carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
+ $cgi;
+}
+
+=item dbh
+
+Returns the DBI database handle.
+
+=cut
+
+sub dbh {
+ $dbh;
+}
+
+=item datasrc
+
+Returns the DBI data source.
+
+=cut
+
+sub datasrc {
+ $datasrc;
+}
+
+=item driver_name
+
+Returns just the driver name portion of the DBI data source.
+
+=cut
+
+sub driver_name {
+ return $driver_name if defined $driver_name;
+ $driver_name = ( split(':', $datasrc) )[1];
+}
+
+sub suidsetup {
+ croak "suidsetup depriciated";
+}
+
+=item getotaker
+
+Returns the current Freeside user.
+
+=cut
+
+sub getotaker {
+ $user;
+}
+
+=item cgisetotaker
+
+Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
+object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
+and derived classes is depriciated.
+
+=cut
+
+sub cgisetotaker {
+ if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
+ carp "Use of CGI::Base is depriciated";
+ $user = lc ( $cgi->var('REMOTE_USER') );
+ } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
+ $user = lc ( $cgi->remote_user );
+ } elsif ( $cgi && $cgi->isa('Apache') ) {
+ $user = lc ( $cgi->connection->user );
+ } else {
+ die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
+ "Apache user authentication as documented in httemplate/docs/install.html";
+ }
+ $user;
+}
+
+=item checkeuid
+
+Returns true if effective UID is that of the freeside user.
+
+=cut
+
+sub checkeuid {
+ ( $> == $freeside_uid );
+}
+
+=item checkruid
+
+Returns true if the real UID is that of the freeside user.
+
+=cut
+
+sub checkruid {
+ ( $< == $freeside_uid );
+}
+
+=item 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.
+
+=cut
+
+sub getsecrets {
+ my($setuser) = shift;
+ $user = $setuser if $setuser;
+ die "No user!" unless $user;
+ my($conf) = new FS::Conf $conf_dir;
+ my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
+ die "User $user not found in mapsecrets!" unless $line;
+ $line =~ /^\s*$user\s+(.*)$/;
+ $secrets = $1;
+ die "Illegal mapsecrets line for user?!" unless $secrets;
+ ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
+ or die "Can't get secrets: $!";
+ $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
+ undef $driver_name;
+ ($datasrc, $db_user, $db_pass);
+}
+
+=back
+
+=head1 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'};
+
+=head1 VERSION
+
+$Id: UID.pm,v 1.14 2002-02-23 07:00:21 ivan Exp $
+
+=head1 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.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::agent;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::agent_type;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::agent - Object methods for agent records
+
+=head1 SYNOPSIS
+
+ use FS::agent;
+
+ $record = new FS::agent \%hash;
+ $record = new FS::agent { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $agent_type = $record->agent_type;
+
+ $hashref = $record->pkgpart_hashref;
+ #may purchase $pkgpart if $hashref->{$pkgpart};
+
+=head1 DESCRIPTION
+
+An FS::agent object represents an agent. Every customer has an agent. Agents
+can be used to track things like resellers or salespeople. FS::agent inherits
+from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item agentnum - primary key (assigned automatically for new agents)
+
+=item agent - Text name of this agent
+
+=item typenum - Agent type. See L<FS::agent_type>
+
+=item prog - For future use.
+
+=item freq - For future use.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new agent. To add the agent to the database, see L<"insert">.
+
+=cut
+
+sub table { 'agent'; }
+
+=item insert
+
+Adds this agent to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this agent from the database. Only agents with no customers can be
+deleted. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ return "Can't delete an agent with customers!"
+ if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } );
+
+ $self->SUPER::delete;
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid agent. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('agentnum')
+ || $self->ut_text('agent')
+ || $self->ut_number('typenum')
+ || $self->ut_numbern('freq')
+ || $self->ut_textn('prog')
+ ;
+ return $error if $error;
+
+ return "Unknown typenum!"
+ unless $self->agent_type;
+
+ '';
+
+}
+
+=item agent_type
+
+Returns the FS::agent_type object (see L<FS::agent_type>) for this agent.
+
+=cut
+
+sub agent_type {
+ my $self = shift;
+ qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
+}
+
+=item pkgpart_hashref
+
+Returns a hash reference. The keys of the hash are pkgparts. The value is
+true if this agent may purchase the specified package definition. See
+L<FS::part_pkg>.
+
+=cut
+
+sub pkgpart_hashref {
+ my $self = shift;
+ $self->agent_type->pkgpart_hashref;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: agent.pm,v 1.3 2002-03-24 18:23:47 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, L<FS::part_pkg>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::agent_type;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch );
+use FS::agent;
+use FS::type_pkgs;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::agent_type - Object methods for agent_type records
+
+=head1 SYNOPSIS
+
+ use FS::agent_type;
+
+ $record = new FS::agent_type \%hash;
+ $record = new FS::agent_type { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $hashref = $record->pkgpart_hashref;
+ #may purchase $pkgpart if $hashref->{$pkgpart};
+
+ @type_pkgs = $record->type_pkgs;
+
+ @pkgparts = $record->pkgpart;
+
+=head1 DESCRIPTION
+
+An FS::agent_type object represents an agent type. Every agent (see
+L<FS::agent>) has an agent type. Agent types define which packages (see
+L<FS::part_pkg>) may be purchased by customers (see L<FS::cust_main>), via
+FS::type_pkgs records (see L<FS::type_pkgs>). FS::agent_type inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item typenum - primary key (assigned automatically for new agent types)
+
+=item atype - Text name of this agent type
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new agent type. To add the agent type to the database, see
+L<"insert">.
+
+=cut
+
+sub table { 'agent_type'; }
+
+=item insert
+
+Adds this agent type to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this agent type from the database. Only agent types with no agents
+can be deleted. If there is an error, returns the error, otherwise returns
+false.
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ return "Can't delete an agent_type with agents!"
+ if qsearch( 'agent', { 'typenum' => $self->typenum } );
+
+ $self->SUPER::delete;
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid agent type. If there is an
+error, returns the error, otherwise returns false. Called by the insert and
+replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('typenum')
+ or $self->ut_text('atype');
+
+}
+
+=item pkgpart_hashref
+
+Returns a hash reference. The keys of the hash are pkgparts. The value is
+true iff this agent may purchase the specified package definition. See
+L<FS::part_pkg>.
+
+=cut
+
+sub pkgpart_hashref {
+ my $self = shift;
+ my %pkgpart;
+ #$pkgpart{$_}++ foreach $self->pkgpart;
+ # not compatible w/5.004_04 (fixed in 5.004_05)
+ foreach ( $self->pkgpart ) { $pkgpart{$_}++; }
+ \%pkgpart;
+}
+
+=item type_pkgs
+
+Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this agent type.
+
+=cut
+
+sub type_pkgs {
+ my $self = shift;
+ qsearch('type_pkgs', { 'typenum' => $self->typenum } );
+}
+
+=item pkgpart
+
+Returns the pkgpart of all package definitions (see L<FS::part_pkg>) for this
+agent type.
+
+=cut
+
+sub pkgpart {
+ my $self = shift;
+ map $_->pkgpart, $self->type_pkgs;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::agent>, L<FS::type_pkgs>, L<FS::cust_main>,
+L<FS::part_pkg>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_bill;
+
+use strict;
+use vars qw( @ISA $conf $money_char );
+use vars qw( $lpr $invoice_from $smtpmachine );
+use vars qw( $processor );
+use vars qw( $xaction $E_NoErr );
+use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options );
+use vars qw( $invoice_lines @buf ); #yuck
+use Date::Format;
+use Mail::Internet 1.44;
+use Mail::Header;
+use Text::Template;
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::cust_bill_pkg;
+use FS::cust_credit;
+use FS::cust_pay;
+use FS::cust_pkg;
+use FS::cust_credit_bill;
+use FS::cust_pay_batch;
+use FS::cust_bill_event;
+
+@ISA = qw( FS::Record );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_bill'} = sub {
+
+ $conf = new FS::Conf;
+
+ $money_char = $conf->config('money_char') || '$';
+
+ $lpr = $conf->config('lpr');
+ $invoice_from = $conf->config('invoice_from');
+ $smtpmachine = $conf->config('smtpmachine');
+
+ if ( $conf->exists('cybercash3.2') ) {
+ require CCMckLib3_2;
+ #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
+ require CCMckDirectLib3_2;
+ #qw(SendCC2_1Server);
+ require CCMckErrno3_2;
+ #qw(MCKGetErrorMessage $E_NoErr);
+ import CCMckErrno3_2 qw($E_NoErr);
+
+ my $merchant_conf;
+ ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
+ my $status = &CCMckLib3_2::InitConfig($merchant_conf);
+ if ( $status != $E_NoErr ) {
+ warn "CCMckLib3_2::InitConfig error:\n";
+ foreach my $key (keys %CCMckLib3_2::Config) {
+ warn " $key => $CCMckLib3_2::Config{$key}\n"
+ }
+ my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
+ die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
+ }
+ $processor='cybercash3.2';
+ } elsif ( $conf->exists('business-onlinepayment') ) {
+ ( $bop_processor,
+ $bop_login,
+ $bop_password,
+ $bop_action,
+ @bop_options
+ ) = $conf->config('business-onlinepayment');
+ $bop_action ||= 'normal authorization';
+ eval "use Business::OnlinePayment";
+ $processor="Business::OnlinePayment::$bop_processor";
+ }
+
+};
+
+=head1 NAME
+
+FS::cust_bill - Object methods for cust_bill records
+
+=head1 SYNOPSIS
+
+ use FS::cust_bill;
+
+ $record = new FS::cust_bill \%hash;
+ $record = new FS::cust_bill { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
+
+ @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
+
+ ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
+
+ @cust_pay_objects = $cust_bill->cust_pay;
+
+ $tax_amount = $record->tax;
+
+ @lines = $cust_bill->print_text;
+ @lines = $cust_bill->print_text $time;
+
+=head1 DESCRIPTION
+
+An FS::cust_bill object represents an invoice; a declaration that a customer
+owes you money. The specific charges are itemized as B<cust_bill_pkg> records
+(see L<FS::cust_bill_pkg>). FS::cust_bill inherits from FS::Record. The
+following fields are currently supported:
+
+=over 4
+
+=item invnum - primary key (assigned automatically for new invoices)
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item charged - amount of this invoice
+
+=item printed - deprecated
+
+=item closed - books closed flag, empty or `Y'
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new invoice. To add the invoice to the database, see L<"insert">.
+Invoices are normally created by calling the bill method of a customer object
+(see L<FS::cust_main>).
+
+=cut
+
+sub table { 'cust_bill'; }
+
+=item insert
+
+Adds this invoice to the database ("Posts" the invoice). If there is an error,
+returns the error, otherwise returns false.
+
+=item delete
+
+Currently unimplemented. I don't remove invoices because there would then be
+no record you ever posted this invoice (which is bad, no?)
+
+=cut
+
+sub delete {
+ my $self = shift;
+ return "Can't delete closed invoice" if $self->closed =~ /^Y/i;
+ $self->SUPER::delete(@_);
+}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+Only printed may be changed. printed is normally updated by calling the
+collect method of a customer object (see L<FS::cust_main>).
+
+=cut
+
+sub replace {
+ my( $new, $old ) = ( shift, shift );
+ return "Can't change custnum!" unless $old->custnum == $new->custnum;
+ #return "Can't change _date!" unless $old->_date eq $new->_date;
+ return "Can't change _date!" unless $old->_date == $new->_date;
+ return "Can't change charged!" unless $old->charged == $new->charged;
+
+ $new->SUPER::replace($old);
+}
+
+=item check
+
+Checks all fields to make sure this is a valid invoice. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('invnum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('charged')
+ || $self->ut_numbern('printed')
+ || $self->ut_enum('closed', [ '', 'Y' ])
+ ;
+ return $error if $error;
+
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->_date(time) unless $self->_date;
+
+ $self->printed(0) if $self->printed eq '';
+
+ ''; #no error
+}
+
+=item previous
+
+Returns a list consisting of the total previous balance for this customer,
+followed by the previous outstanding invoices (as FS::cust_bill objects also).
+
+=cut
+
+sub previous {
+ my $self = shift;
+ my $total = 0;
+ my @cust_bill = sort { $a->_date <=> $b->_date }
+ grep { $_->owed != 0 && $_->_date < $self->_date }
+ qsearch( 'cust_bill', { 'custnum' => $self->custnum } )
+ ;
+ foreach ( @cust_bill ) { $total += $_->owed; }
+ $total, @cust_bill;
+}
+
+=item cust_bill_pkg
+
+Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
+
+=cut
+
+sub cust_bill_pkg {
+ my $self = shift;
+ qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
+}
+
+=item cust_bill_event
+
+Returns the completed invoice events (see L<FS::cust_bill_event>) for this
+invoice.
+
+=cut
+
+sub cust_bill_event {
+ my $self = shift;
+ qsearch( 'cust_bill_event', { 'invnum' => $self->invnum } );
+}
+
+
+=item cust_main
+
+Returns the customer (see L<FS::cust_main>) for this invoice.
+
+=cut
+
+sub cust_main {
+ my $self = shift;
+ qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+}
+
+=item cust_credit
+
+Depreciated. See the cust_credited method.
+
+ #Returns a list consisting of the total previous credited (see
+ #L<FS::cust_credit>) and unapplied for this customer, followed by the previous
+ #outstanding credits (FS::cust_credit objects).
+
+=cut
+
+sub cust_credit {
+ use Carp;
+ croak "FS::cust_bill->cust_credit depreciated; see ".
+ "FS::cust_bill->cust_credit_bill";
+ #my $self = shift;
+ #my $total = 0;
+ #my @cust_credit = sort { $a->_date <=> $b->_date }
+ # grep { $_->credited != 0 && $_->_date < $self->_date }
+ # qsearch('cust_credit', { 'custnum' => $self->custnum } )
+ #;
+ #foreach (@cust_credit) { $total += $_->credited; }
+ #$total, @cust_credit;
+}
+
+=item cust_pay
+
+Depreciated. See the cust_bill_pay method.
+
+#Returns all payments (see L<FS::cust_pay>) for this invoice.
+
+=cut
+
+sub cust_pay {
+ use Carp;
+ croak "FS::cust_bill->cust_pay depreciated; see FS::cust_bill->cust_bill_pay";
+ #my $self = shift;
+ #sort { $a->_date <=> $b->_date }
+ # qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
+ #;
+}
+
+=item cust_bill_pay
+
+Returns all payment applications (see L<FS::cust_bill_pay>) for this invoice.
+
+=cut
+
+sub cust_bill_pay {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_bill_pay', { 'invnum' => $self->invnum } );
+}
+
+=item cust_credited
+
+Returns all applied credits (see L<FS::cust_credit_bill>) for this invoice.
+
+=cut
+
+sub cust_credited {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_credit_bill', { 'invnum' => $self->invnum } )
+ ;
+}
+
+=item tax
+
+Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice.
+
+=cut
+
+sub tax {
+ my $self = shift;
+ my $total = 0;
+ my @taxlines = qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum ,
+ 'pkgnum' => 0 } );
+ foreach (@taxlines) { $total += $_->setup; }
+ $total;
+}
+
+=item owed
+
+Returns the amount owed (still outstanding) on this invoice, which is charged
+minus all payment applications (see L<FS::cust_bill_pay>) and credit
+applications (see L<FS::cust_credit_bill>).
+
+=cut
+
+sub owed {
+ my $self = shift;
+ my $balance = $self->charged;
+ $balance -= $_->amount foreach ( $self->cust_bill_pay );
+ $balance -= $_->amount foreach ( $self->cust_credited );
+ $balance = sprintf( "%.2f", $balance);
+ $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
+ $balance;
+}
+
+=item send
+
+Sends this invoice to the destinations configured for this customer: send
+emails or print. See L<FS::cust_main_invoice>.
+
+=cut
+
+sub send {
+ my($self,$template) = @_;
+
+ #my @print_text = $cust_bill->print_text; #( date )
+ my @invoicing_list = $self->cust_main->invoicing_list;
+ if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
+ #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card
+ #$ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Invoice",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ $self->print_text('', $template) ], #( date)
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or return "(customer # ". $self->custnum. ") can't send invoice email".
+ " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ).
+ " via server $smtpmachine with SMTP: $!";
+
+ #} elsif ( grep { $_ eq 'POST' } @invoicing_list ) {
+ } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
+ open(LPR, "|$lpr")
+ or return "Can't open pipe to $lpr: $!";
+ print LPR $self->print_text; #( date )
+ close LPR
+ or return $! ? "Error closing $lpr: $!"
+ : "Exit status $? from $lpr";
+ }
+
+ '';
+
+}
+
+=item comp
+
+Pays this invoice with a compliemntary payment. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub comp {
+ my $self = shift;
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $self->invnum,
+ 'paid' => $self->owed,
+ '_date' => '',
+ 'payby' => 'COMP',
+ 'payinfo' => $self->cust_main->payinfo,
+ 'paybatch' => '',
+ } );
+ $cust_pay->insert;
+}
+
+=item realtime_card
+
+Attempts to pay this invoice with a Business::OnlinePayment realtime gateway.
+See http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment
+for supproted processors.
+
+=cut
+
+sub realtime_card {
+ my $self = shift;
+ my $cust_main = $self->cust_main;
+ my $amount = $self->owed;
+
+ unless ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) {
+ return "Real-time card processing not enabled (processor $processor)";
+ }
+ my $bop_processor = $1; #hmm?
+
+ my $address = $cust_main->address1;
+ $address .= ", ". $cust_main->address2 if $cust_main->address2;
+
+ #fix exp. date
+ #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ my $exp = "$2/$1";
+
+ my($payname, $payfirst, $paylast);
+ if ( $cust_main->payname ) {
+ $payname = $cust_main->payname;
+ $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
+ or do {
+ #$dbh->rollback if $oldAutoCommit;
+ return "Illegal payname $payname";
+ };
+ ($payfirst, $paylast) = ($1, $2);
+ } else {
+ $payfirst = $cust_main->getfield('first');
+ $paylast = $cust_main->getfield('last');
+ $payname = "$payfirst $paylast";
+ }
+
+ my @invoicing_list = grep { $_ ne 'POST' } $cust_main->invoicing_list;
+ if ( $conf->exists('emailinvoiceauto')
+ || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
+ push @invoicing_list, $cust_main->default_invoicing_list;
+ }
+ my $email = $invoicing_list[0];
+
+ my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action );
+
+ my $description = 'Internet Services';
+ if ( $conf->exists('business-onlinepayment-description') ) {
+ my $dtempl = $conf->config('business-onlinepayment-description');
+
+ my $agent_obj = $cust_main->agent
+ or die "can't retreive agent for $cust_main (agentnum ".
+ $cust_main->agentnum. ")";
+ my $agent = $agent_obj->agent;
+ my $pkgs = join(', ',
+ map { $_->cust_pkg->part_pkg->pkg }
+ grep { $_->pkgnum } $self->cust_bill_pkg
+ );
+ $description = eval qq("$dtempl");
+
+ }
+
+ my $transaction =
+ new Business::OnlinePayment( $bop_processor, @bop_options );
+ $transaction->content(
+ 'type' => 'CC',
+ 'login' => $bop_login,
+ 'password' => $bop_password,
+ 'action' => $action1,
+ 'description' => $description,
+ 'amount' => $amount,
+ 'invoice_number' => $self->invnum,
+ 'customer_id' => $self->custnum,
+ 'last_name' => $paylast,
+ 'first_name' => $payfirst,
+ 'name' => $payname,
+ 'address' => $address,
+ 'city' => $cust_main->city,
+ 'state' => $cust_main->state,
+ 'zip' => $cust_main->zip,
+ 'country' => $cust_main->country,
+ 'card_number' => $cust_main->payinfo,
+ 'expiration' => $exp,
+ 'referer' => 'http://cleanwhisker.420.am/',
+ 'email' => $email,
+ 'phone' => $cust_main->daytime || $cust_main->night,
+ );
+ $transaction->submit();
+
+ if ( $transaction->is_success() && $action2 ) {
+ my $auth = $transaction->authorization;
+ my $ordernum = $transaction->order_number;
+ #warn "********* $auth ***********\n";
+ #warn "********* $ordernum ***********\n";
+ my $capture =
+ new Business::OnlinePayment( $bop_processor, @bop_options );
+
+ $capture->content(
+ action => $action2,
+ login => $bop_login,
+ password => $bop_password,
+ order_number => $ordernum,
+ amount => $amount,
+ authorization => $auth,
+ description => $description,
+ );
+
+ $capture->submit();
+
+ unless ( $capture->is_success ) {
+ my $e = "Authorization sucessful but capture failed, invnum #".
+ $self->invnum. ': '. $capture->result_code.
+ ": ". $capture->error_message;
+ warn $e;
+ return $e;
+ }
+
+ }
+
+ if ( $transaction->is_success() ) {
+
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $self->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'CARD',
+ 'payinfo' => $cust_main->payinfo,
+ 'paybatch' => "$processor:". $transaction->authorization,
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ # gah, even with transactions.
+ my $e = 'WARNING: Card debited but database not updated - '.
+ 'error applying payment, invnum #' . $self->invnum.
+ " ($processor): $error";
+ warn $e;
+ return $e;
+ } else {
+ return '';
+ }
+ #} elsif ( $options{'report_badcard'} ) {
+ } else {
+
+ my $perror = "$processor error, invnum #". $self->invnum. ': '.
+ $transaction->result_code. ": ". $transaction->error_message;
+
+ if ( $conf->exists('emaildecline')
+ && grep { $_ ne 'POST' } $cust_main->invoicing_list
+ ) {
+ my @templ = $conf->config('declinetemplate');
+ my $template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @templ ],
+ ) or return "($perror) can't create template: $Text::Template::ERROR";
+ $template->compile()
+ or return "($perror) can't compile template: $Text::Template::ERROR";
+
+ my $error = $transaction->error_message;
+
+ #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Your credit card could not be processed",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ $template->fill_in() ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or return "($perror) (customer # ". $self->custnum.
+ ") can't send card decline email to ".
+ join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ).
+ " via server $smtpmachine with SMTP: $!";
+ }
+
+ return $perror;
+ }
+
+}
+
+=item realtime_card_cybercash
+
+Attempts to pay this invoice with the CyberCash CashRegister realtime gateway.
+
+=cut
+
+sub realtime_card_cybercash {
+ my $self = shift;
+ my $cust_main = $self->cust_main;
+ my $amount = $self->owed;
+
+ return "CyberCash CashRegister real-time card processing not enabled!"
+ unless $processor eq 'cybercash3.2';
+
+ my $address = $cust_main->address1;
+ $address .= ", ". $cust_main->address2 if $cust_main->address2;
+
+ #fix exp. date
+ #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ my $exp = "$2/$1";
+
+ #
+
+ my $paybatch = $self->invnum.
+ '-' . time2str("%y%m%d%H%M%S", time);
+
+ my $payname = $cust_main->payname ||
+ $cust_main->getfield('first').' '.$cust_main->getfield('last');
+
+ my $country = $cust_main->country eq 'US' ? 'USA' : $cust_main->country;
+
+ my @full_xaction = ( $xaction,
+ 'Order-ID' => $paybatch,
+ 'Amount' => "usd $amount",
+ 'Card-Number' => $cust_main->getfield('payinfo'),
+ 'Card-Name' => $payname,
+ 'Card-Address' => $address,
+ 'Card-City' => $cust_main->getfield('city'),
+ 'Card-State' => $cust_main->getfield('state'),
+ 'Card-Zip' => $cust_main->getfield('zip'),
+ 'Card-Country' => $country,
+ 'Card-Exp' => $exp,
+ );
+
+ my %result;
+ %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
+
+ if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $self->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'CARD',
+ 'payinfo' => $cust_main->payinfo,
+ 'paybatch' => "$processor:$paybatch",
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ # gah, even with transactions.
+ my $e = 'WARNING: Card debited but database not updated - '.
+ 'error applying payment, invnum #' . $self->invnum.
+ " (CyberCash Order-ID $paybatch): $error";
+ warn $e;
+ return $e;
+ } else {
+ return '';
+ }
+# } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
+# || $options{'report_badcard'}
+# ) {
+ } else {
+ return 'Cybercash error, invnum #' .
+ $self->invnum. ':'. $result{'MErrMsg'};
+ }
+
+}
+
+=item batch_card
+
+Adds a payment for this invoice to the pending credit card batch (see
+L<FS::cust_pay_batch>).
+
+=cut
+
+sub batch_card {
+ my $self = shift;
+ my $cust_main = $self->cust_main;
+
+ my $cust_pay_batch = new FS::cust_pay_batch ( {
+ 'invnum' => $self->getfield('invnum'),
+ 'custnum' => $cust_main->getfield('custnum'),
+ 'last' => $cust_main->getfield('last'),
+ 'first' => $cust_main->getfield('first'),
+ 'address1' => $cust_main->getfield('address1'),
+ 'address2' => $cust_main->getfield('address2'),
+ 'city' => $cust_main->getfield('city'),
+ 'state' => $cust_main->getfield('state'),
+ 'zip' => $cust_main->getfield('zip'),
+ 'country' => $cust_main->getfield('country'),
+ 'trancode' => 77,
+ 'cardnum' => $cust_main->getfield('payinfo'),
+ 'exp' => $cust_main->getfield('paydate'),
+ 'payname' => $cust_main->getfield('payname'),
+ 'amount' => $self->owed,
+ } );
+ $cust_pay_batch->insert;
+
+}
+
+=item print_text [TIME];
+
+Returns an text invoice, as a list of lines.
+
+TIME an optional value used to control the printing of overdue messages. The
+default is now. It isn't the date of the invoice; that's the `_date' field.
+It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub print_text {
+
+ my( $self, $today, $template ) = @_;
+ $today ||= time;
+# my $invnum = $self->invnum;
+ my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } );
+ $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') )
+ unless $cust_main->payname;
+
+ my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
+# my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits
+ #my $balance_due = $self->owed + $pr_total - $cr_total;
+ my $balance_due = $self->owed + $pr_total;
+
+ #my @collect = ();
+ #my($description,$amount);
+ @buf = ();
+
+ #previous balance
+ foreach ( @pr_cust_bill ) {
+ push @buf, [
+ "Previous Balance, Invoice #". $_->invnum.
+ " (". time2str("%x",$_->_date). ")",
+ $money_char. sprintf("%10.2f",$_->owed)
+ ];
+ }
+ if (@pr_cust_bill) {
+ push @buf,['','-----------'];
+ push @buf,[ 'Total Previous Balance',
+ $money_char. sprintf("%10.2f",$pr_total ) ];
+ push @buf,['',''];
+ }
+
+ #new charges
+ foreach ( $self->cust_bill_pkg ) {
+
+ if ( $_->pkgnum ) {
+
+ my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
+ my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
+ my($pkg)=$part_pkg->pkg;
+
+ if ( $_->setup != 0 ) {
+ push @buf, [ "$pkg Setup", $money_char. sprintf("%10.2f",$_->setup) ];
+ push @buf,
+ map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels;
+ }
+
+ if ( $_->recur != 0 ) {
+ push @buf, [
+ "$pkg (" . time2str("%x",$_->sdate) . " - " .
+ time2str("%x",$_->edate) . ")",
+ $money_char. sprintf("%10.2f",$_->recur)
+ ];
+ push @buf,
+ map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels;
+ }
+
+ } else { #pkgnum Tax
+ push @buf,["Tax", $money_char. sprintf("%10.2f",$_->setup) ]
+ if $_->setup != 0;
+ }
+ }
+
+ push @buf,['','-----------'];
+ push @buf,['Total New Charges',
+ $money_char. sprintf("%10.2f",$self->charged) ];
+ push @buf,['',''];
+
+ push @buf,['','-----------'];
+ push @buf,['Total Charges',
+ $money_char. sprintf("%10.2f",$self->charged + $pr_total) ];
+ push @buf,['',''];
+
+ #credits
+ foreach ( $self->cust_credited ) {
+
+ #something more elaborate if $_->amount ne $_->cust_credit->credited ?
+
+ my $reason = substr($_->cust_credit->reason,0,32);
+ $reason .= '...' if length($reason) < length($_->cust_credit->reason);
+ $reason = " ($reason) " if $reason;
+ push @buf,[
+ "Credit #". $_->crednum. " (". time2str("%x",$_->cust_credit->_date) .")".
+ $reason,
+ $money_char. sprintf("%10.2f",$_->amount)
+ ];
+ }
+ #foreach ( @cr_cust_credit ) {
+ # push @buf,[
+ # "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
+ # $money_char. sprintf("%10.2f",$_->credited)
+ # ];
+ #}
+
+ #get & print payments
+ foreach ( $self->cust_bill_pay ) {
+
+ #something more elaborate if $_->amount ne ->cust_pay->paid ?
+
+ push @buf,[
+ "Payment received ". time2str("%x",$_->cust_pay->_date ),
+ $money_char. sprintf("%10.2f",$_->amount )
+ ];
+ }
+
+ #balance due
+ push @buf,['','-----------'];
+ push @buf,['Balance Due', $money_char.
+ sprintf("%10.2f", $balance_due ) ];
+
+ #create the template
+ my $templatefile = 'invoice_template';
+ $templatefile .= "_$template" if $template;
+ my @invoice_template = $conf->config($templatefile)
+ or die "cannot load config file $templatefile";
+ $invoice_lines = 0;
+ my $wasfunc = 0;
+ foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy
+ /invoice_lines\((\d+)\)/;
+ $invoice_lines += $1;
+ $wasfunc=1;
+ }
+ die "no invoice_lines() functions in template?" unless $wasfunc;
+ my $invoice_template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @invoice_template ],
+ ) or die "can't create new Text::Template object: $Text::Template::ERROR";
+ $invoice_template->compile()
+ or die "can't compile template: $Text::Template::ERROR";
+
+ #setup template variables
+ package FS::cust_bill::_template; #!
+ use vars qw( $invnum $date $page $total_pages @address $overdue @buf );
+
+ $invnum = $self->invnum;
+ $date = $self->_date;
+ $page = 1;
+
+ if ( $FS::cust_bill::invoice_lines ) {
+ $total_pages =
+ int( scalar(@FS::cust_bill::buf) / $FS::cust_bill::invoice_lines );
+ $total_pages++
+ if scalar(@FS::cust_bill::buf) % $FS::cust_bill::invoice_lines;
+ } else {
+ $total_pages = 1;
+ }
+
+ #format address (variable for the template)
+ my $l = 0;
+ @address = ( '', '', '', '', '', '' );
+ package FS::cust_bill; #!
+ $FS::cust_bill::_template::address[$l++] =
+ $cust_main->payname.
+ ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo
+ ? " (P.O. #". $cust_main->payinfo. ")"
+ : ''
+ )
+ ;
+ $FS::cust_bill::_template::address[$l++] = $cust_main->company
+ if $cust_main->company;
+ $FS::cust_bill::_template::address[$l++] = $cust_main->address1;
+ $FS::cust_bill::_template::address[$l++] = $cust_main->address2
+ if $cust_main->address2;
+ $FS::cust_bill::_template::address[$l++] =
+ $cust_main->city. ", ". $cust_main->state. " ". $cust_main->zip;
+ $FS::cust_bill::_template::address[$l++] = $cust_main->country
+ unless $cust_main->country eq 'US';
+
+ # #overdue? (variable for the template)
+ # $FS::cust_bill::_template::overdue = (
+ # $balance_due > 0
+ # && $today > $self->_date
+ ## && $self->printed > 1
+ # && $self->printed > 0
+ # );
+
+ #and subroutine for the template
+
+ sub FS::cust_bill::_template::invoice_lines {
+ my $lines = shift or return @buf;
+ map {
+ scalar(@buf) ? shift @buf : [ '', '' ];
+ }
+ ( 1 .. $lines );
+ }
+
+
+ #and fill it in
+ $FS::cust_bill::_template::page = 1;
+ my $lines;
+ my @collect;
+ while (@buf) {
+ push @collect, split("\n",
+ $invoice_template->fill_in( PACKAGE => 'FS::cust_bill::_template' )
+ );
+ $FS::cust_bill::_template::page++;
+ }
+
+ map "$_\n", @collect;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_bill.pm,v 1.35 2002-05-18 09:51:30 ivan Exp $
+
+=head1 BUGS
+
+The delete method.
+
+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?)
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill_pay>, L<FS::cust_pay>,
+L<FS::cust_bill_pkg>, L<FS::cust_bill_credit>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_bill_event;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_bill_event;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::cust_bill_event - Object methods for cust_bill_event records
+
+=head1 SYNOPSIS
+
+ use FS::cust_bill_event;
+
+ $record = new FS::cust_bill_event \%hash;
+ $record = new FS::cust_bill_event { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_bill_event object represents an complete invoice event.
+FS::cust_bill_event inherits from FS::Record. The following fields are
+currently supported:
+
+=over 4
+
+=item eventnum - primary key
+
+=item invnum - invoice (see L<FS::cust_bill>)
+
+=item eventpart - event definition (see L<FS::part_bill_event>)
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new completed invoice event. To add the compelted invoice event to
+the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'cust_bill_event'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid completed invoice event. If
+there is an error, returns the error, otherwise returns false. Called by the
+insert and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error = $self->ut_numbern('eventnum')
+ || $self->ut_number('invnum')
+ || $self->ut_number('eventpart')
+ || $self->ut_number('_date')
+ || $self->ut_enum('status', [qw( done failed )])
+ || $self->ut_textn('statustext')
+ ;
+
+ return "Unknown invnum"
+ unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
+
+ return "Unknown eventpart"
+ unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } );
+
+ ''; #no error
+}
+
+=item part_bill_event
+
+Returns the invoice event definition (see L<FS::part_bill_event>) for this
+completed invoice event.
+
+=cut
+
+sub part_bill_event {
+ my $self = shift;
+ qsearchs( 'part_bill_event', { 'eventpart' => $self->eventpart } );
+}
+
+=item cust_bill
+
+Returns the invoice (see L<FS::cust_bill>) for this completed invoice event.
+
+=cut
+
+sub cust_bill {
+ my $self = shift;
+ qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
+}
+
+=back
+
+=head1 BUGS
+
+Far too early in the morning.
+
+=head1 SEE ALSO
+
+L<FS::part_bill_event>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_bill_pay;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs dbh );
+use FS::cust_bill;
+use FS::cust_pay;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_bill_pay - Object methods for cust_bill_pay records
+
+=head1 SYNOPSIS
+
+ use FS::cust_bill_pay;
+
+ $record = new FS::cust_bill_pay \%hash;
+ $record = new FS::cust_bill_pay { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_bill_pay object represents the application of a payment to a
+specific invoice. FS::cust_bill_pay inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item billpaynum - primary key (assigned automatically)
+
+=item invnum - Invoice (see L<FS::cust_bill>)
+
+=item paynum - Payment (see L<FS::cust_pay>)
+
+=item amount - Amount of the payment to apply to the specific invoice.
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_bill_pay'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ $error = $self->SUPER::insert;
+
+ my $cust_pay = qsearchs('cust_pay', { 'paynum' => $self->paynum } ) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "unknown cust_pay.paynum: ". $self->paynum;
+ };
+
+ my $pay_total = 0;
+ $pay_total += $_ foreach map { $_->amount }
+ qsearch('cust_bill_pay', { 'paynum' => $self->paynum } );
+
+ if ( sprintf("%.2f", $pay_total) > sprintf("%.2f", $cust_pay->paid) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "total cust_bill_pay.amount $pay_total for paynum ". $self->paynum.
+ " greater than cust_pay.paid ". $cust_pay->paid;
+ }
+
+ my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } ) or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "unknown cust_bill.invnum: ". $self->invnum;
+ };
+
+ my $bill_total = 0;
+ $bill_total += $_ foreach map { $_->amount }
+ qsearch('cust_bill_pay', { 'invnum' => $self->invnum } );
+ $bill_total += $_ foreach map { $_->amount }
+ qsearch('cust_credit_bill', { 'invnum' => $self->invnum } );
+ if ( sprintf("%.2f", $bill_total) > sprintf("%.2f", $cust_bill->charged) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "total cust_bill_pay.amount and cust_credit_bill.amount $bill_total".
+ " for invnum ". $self->invnum.
+ " greater than cust_bill.charged ". $cust_bill->charged;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item delete
+
+Deletes this payment application, unless the closed flag for the parent payment
+(see L<FS::cust_pay>) is set.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ return "Can't delete application for closed payment"
+ if $self->cust_pay->closed =~ /^Y/i;
+ $self->SUPER::delete(@_);
+}
+
+=item replace OLD_RECORD
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub replace {
+ return "Can't (yet?) modify cust_bill_pay records!";
+}
+
+=item check
+
+Checks all fields to make sure this is a valid payment. If there is an error,
+returns the error, otherwise returns false. Called by the insert method.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('billpaynum')
+ || $self->ut_number('invnum')
+ || $self->ut_number('paynum')
+ || $self->ut_money('amount')
+ || $self->ut_numbern('_date')
+ ;
+ return $error if $error;
+
+ return "amount must be > 0" if $self->amount <= 0;
+
+ $self->_date(time) unless $self->_date;
+
+ ''; #no error
+}
+
+=item cust_pay
+
+Returns the payment (see L<FS::cust_pay>)
+
+=cut
+
+sub cust_pay {
+ my $self = shift;
+ qsearchs( 'cust_pay', { 'paynum' => $self->paynum } );
+}
+
+=item cust_bill
+
+Returns the invoice (see L<FS::cust_bill>)
+
+=cut
+
+sub cust_bill {
+ my $self = shift;
+ qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_bill_pay.pm,v 1.12 2002-02-07 22:29:34 ivan Exp $
+
+=head1 BUGS
+
+Delete and replace methods.
+
+the checks for over-applied payments could be better done like the ones in
+cust_bill_credit
+
+=head1 SEE ALSO
+
+L<FS::cust_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_bill_pkg;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
+use FS::cust_pkg;
+use FS::cust_bill;
+
+@ISA = qw(FS::Record );
+
+=head1 NAME
+
+FS::cust_bill_pkg - Object methods for cust_bill_pkg records
+
+=head1 SYNOPSIS
+
+ use FS::cust_bill_pkg;
+
+ $record = new FS::cust_bill_pkg \%hash;
+ $record = new FS::cust_bill_pkg { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_bill_pkg object represents an invoice line item.
+FS::cust_bill_pkg inherits from FS::Record. The following fields are currently
+supported:
+
+=over 4
+
+=item invnum - invoice (see L<FS::cust_bill>)
+
+=item pkgnum - package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package
+
+=item setup - setup fee
+
+=item recur - recurring fee
+
+=item sdate - starting date of recurring fee
+
+=item edate - ending date of recurring fee
+
+=back
+
+sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
+see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new line item. To add the line item to the database, see
+L<"insert">. Line items are normally created by calling the bill method of a
+customer object (see L<FS::cust_main>).
+
+=cut
+
+sub table { 'cust_bill_pkg'; }
+
+=item insert
+
+Adds this line item to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Currently unimplemented. I don't remove line items because there would then be
+no record the items ever existed (which is bad, no?)
+
+=cut
+
+sub delete {
+ return "Can't delete cust_bill_pkg records!";
+}
+
+=item replace OLD_RECORD
+
+Currently unimplemented. This would be even more of an accounting nightmare
+than deleteing the items. Just don't do it.
+
+=cut
+
+sub replace {
+ return "Can't modify cust_bill_pkg records!";
+}
+
+=item check
+
+Checks all fields to make sure this is a valid line item. If there is an
+error, returns the error, otherwise returns false. Called by the insert
+method.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_number('pkgnum')
+ || $self->ut_number('invnum')
+ || $self->ut_money('setup')
+ || $self->ut_money('recur')
+ || $self->ut_numbern('sdate')
+ || $self->ut_numbern('edate')
+ ;
+ return $error if $error;
+
+ if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
+ return "Unknown pkgnum ". $self->pkgnum
+ unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+ }
+
+ return "Unknown invnum"
+ unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
+
+ ''; #no error
+}
+
+=item cust_pkg
+
+Returns the package (see L<FS::cust_pkg>) for this invoice line item.
+
+=cut
+
+sub cust_pkg {
+ my $self = shift;
+ qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
+from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_credit;
+
+use strict;
+use vars qw( @ISA $conf $unsuspendauto );
+use FS::UID qw( dbh getotaker );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::cust_refund;
+use FS::cust_credit_bill;
+
+@ISA = qw( FS::Record );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_credit'} = sub {
+
+ $conf = new FS::Conf;
+ $unsuspendauto = $conf->exists('unsuspendauto');
+
+};
+
+=head1 NAME
+
+FS::cust_credit - Object methods for cust_credit records
+
+=head1 SYNOPSIS
+
+ use FS::cust_credit;
+
+ $record = new FS::cust_credit \%hash;
+ $record = new FS::cust_credit { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_credit object represents a credit; the equivalent of a negative
+B<cust_bill> record (see L<FS::cust_bill>). FS::cust_credit inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item crednum - primary key (assigned automatically for new credits)
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item amount - amount of the credit
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item otaker - order taker (assigned automatically, see L<FS::UID>)
+
+=item reason - text
+
+=item closed - books closed flag, empty or `Y'
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new credit. To add the credit to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_credit'; }
+
+=item insert
+
+Adds this credit to the database ("Posts" the credit). If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+ my $old_balance = $cust_main->balance;
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error inserting $self: $error";
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ #false laziness w/ cust_credit::insert
+ if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
+ my @errors = $cust_main->unsuspend;
+ #return
+ # side-fx with nested transactions? upstack rolls back?
+ warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
+ join(' / ', @errors)
+ if @errors;
+ }
+ #eslaf
+
+ '';
+
+}
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ return "Can't delete closed credit" if $self->closed =~ /^Y/i;
+ $self->SUPER::delete(@_);
+}
+
+=item replace OLD_RECORD
+
+Credits may not be modified; there would then be no record the credit was ever
+posted.
+
+=cut
+
+sub replace {
+ return "Can't modify credit!"
+}
+
+=item check
+
+Checks all fields to make sure this is a valid credit. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('crednum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('amount')
+ || $self->ut_textn('reason')
+ || $self->ut_enum('closed', [ '', 'Y' ])
+ ;
+ return $error if $error;
+
+ return "amount must be > 0 " if $self->amount <= 0;
+
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->_date(time) unless $self->_date;
+
+ $self->otaker(getotaker);
+
+ ''; #no error
+}
+
+=item cust_refund
+
+Depreciated. See the cust_credit_refund method.
+
+#Returns all refunds (see L<FS::cust_refund>) for this credit.
+
+=cut
+
+sub cust_refund {
+ use Carp;
+ croak "FS::cust_credit->cust_pay depreciated; see ".
+ "FS::cust_credit->cust_credit_refund";
+ #my $self = shift;
+ #sort { $a->_date <=> $b->_date }
+ # qsearch( 'cust_refund', { 'crednum' => $self->crednum } )
+ #;
+}
+
+=item cust_credit_refund
+
+Returns all refund applications (see L<FS::cust_credit_refund>) for this credit.
+
+=cut
+
+sub cust_credit_refund {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_credit_refund', { 'crednum' => $self->crednum } )
+ ;
+}
+
+=item cust_credit_bill
+
+Returns all application to invoices (see L<FS::cust_credit_bill>) for this
+credit.
+
+=cut
+
+sub cust_credit_bill {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_credit_bill', { 'crednum' => $self->crednum } )
+ ;
+}
+
+=item credited
+
+Returns the amount of this credit that is still outstanding; which is
+amount minus all refund applications (see L<FS::cust_credit_refund>) and
+applications to invoices (see L<FS::cust_credit_bill>).
+
+=cut
+
+sub credited {
+ my $self = shift;
+ my $amount = $self->amount;
+ $amount -= $_->amount foreach ( $self->cust_credit_refund );
+ $amount -= $_->amount foreach ( $self->cust_credit_bill );
+ sprintf( "%.2f", $amount );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_credit.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $
+
+=head1 BUGS
+
+The delete method.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>,
+L<FS::cust_credit_bill> L<FS::cust_bill>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_credit_bill;
+
+use strict;
+use vars qw( @ISA );
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+#use FS::cust_refund;
+use FS::cust_credit;
+use FS::cust_bill;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_credit_bill - Object methods for cust_credit_bill records
+
+=head1 SYNOPSIS
+
+ use FS::cust_credit_bill;
+
+ $record = new FS::cust_credit_bill \%hash;
+ $record = new FS::cust_credit_bill { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_credit_bill object represents application of a credit (see
+L<FS::cust_credit>) to an invoice (see L<FS::cust_bill>). FS::cust_credit
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item creditbillnum - primary key
+
+=item crednum - credit being applied
+
+=item invnum - invoice to which credit is applied (see L<FS::cust_bill>)
+
+=item amount - amount of the credit applied
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new cust_credit_bill. To add the cust_credit_bill to the database,
+see L<"insert">.
+
+=cut
+
+sub table { 'cust_credit_bill'; }
+
+=item insert
+
+Adds this cust_credit_bill to the database ("Posts" all or part of a credit).
+If there is an error, returns the error, otherwise returns false.
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ return "Can't unapply credit!"
+}
+
+=item replace OLD_RECORD
+
+Application of credits may not be modified.
+
+=cut
+
+sub replace {
+ return "Can't modify application of credit!"
+}
+
+=item check
+
+Checks all fields to make sure this is a valid credit application. If there
+is an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('creditbillnum')
+ || $self->ut_number('crednum')
+ || $self->ut_number('invnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('amount')
+ ;
+ return $error if $error;
+
+ return "amount must be > 0" if $self->amount <= 0;
+
+ return "Unknown credit"
+ unless my $cust_credit =
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
+
+ return "Unknown invoice"
+ unless my $cust_bill =
+ qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
+
+ $self->_date(time) unless $self->_date;
+
+ return "Cannot apply more than remaining value of credit"
+ unless $self->amount <= $cust_credit->credited;
+
+ return "Cannot apply more than remaining value of invoice"
+ unless $self->amount <= $cust_bill->owed;
+
+ ''; #no error
+}
+
+=item sub cust_credit
+
+Returns the credit (see L<FS::cust_credit>)
+
+=cut
+
+sub cust_credit {
+ my $self = shift;
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_credit_bill.pm,v 1.7 2002-01-24 16:58:47 ivan Exp $
+
+=head1 BUGS
+
+The delete method.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, L<FS::cust_credit>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_credit_refund;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs dbh );
+#use FS::UID qw(getotaker);
+use FS::cust_credit;
+use FS::cust_refund;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_credit_refund - Object methods for cust_bill_pay records
+
+=head1 SYNOPSIS
+
+ use FS::cust_credit_refund;
+
+ $record = new FS::cust_credit_refund \%hash;
+ $record = new FS::cust_credit_refund { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_credit_refund represents the application of a refund to a specific
+credit. FS::cust_credit_refund inherits from FS::Record. The following fields
+are currently supported:
+
+=over 4
+
+=item creditrefundnum - primary key (assigned automatically)
+
+=item crednum - Credit (see L<FS::cust_credit>)
+
+=item refundnum - Refund (see L<FS::cust_refund>)
+
+=item amount - Amount of the refund to apply to the specific credit.
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_credit_refund'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ $error = $self->SUPER::insert;
+
+ my $cust_refund =
+ qsearchs('cust_refund', { 'refundnum' => $self->refundnum } )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "unknown cust_refund.refundnum: ". $self->refundnum
+ };
+
+ my $refund_total = 0;
+ $refund_total += $_ foreach map { $_->amount }
+ qsearch('cust_credit_refund', { 'refundnum' => $self->refundnum } );
+
+ if ( $refund_total > $cust_refund->refund ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "total cust_credit_refund.amount $refund_total for refundnum ".
+ $self->refundnum.
+ " greater than cust_refund.refund ". $cust_refund->refund;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item delete
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub delete {
+ return "Can't (yet?) delete cust_credit_refund records!";
+}
+
+=item replace OLD_RECORD
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub replace {
+ return "Can't (yet?) modify cust_credit_refund records!";
+}
+
+=item check
+
+Checks all fields to make sure this is a valid payment. If there is an error,
+returns the error, otherwise returns false. Called by the insert method.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('creditrefundnum')
+ || $self->ut_number('crednum')
+ || $self->ut_number('refundnum')
+ || $self->ut_money('amount')
+ || $self->ut_numbern('_date')
+ ;
+ return $error if $error;
+
+ return "amount must be > 0" if $self->amount <= 0;
+
+ $self->_date(time) unless $self->_date;
+
+ return "unknown cust_credit.crednum: ". $self->crednum
+ unless qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
+
+ ''; #no error
+}
+
+=item cust_refund
+
+Returns the refund (see L<FS::cust_refund>)
+
+=cut
+
+sub cust_refund {
+ my $self = shift;
+ qsearchs( 'cust_refund', { 'refundnum' => $self->refundnum } );
+}
+
+=item cust_credit
+
+Returns the credit (see L<FS::cust_credit>)
+
+=cut
+
+sub cust_credit {
+ my $self = shift;
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $
+
+=head1 BUGS
+
+Delete and replace methods.
+
+the checks for over-applied refunds could be better done like the ones in
+cust_bill_credit
+
+=head1 SEE ALSO
+
+L<FS::cust_credit>, L<FS::cust_refund>, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_main;
+
+use strict;
+use vars qw( @ISA $conf $Debug $import );
+use Safe;
+use Carp;
+use Time::Local;
+use Date::Format;
+#use Date::Manip;
+use Business::CreditCard;
+use FS::UID qw( getotaker dbh );
+use FS::Record qw( qsearchs qsearch dbdef );
+use FS::cust_pkg;
+use FS::cust_bill;
+use FS::cust_bill_pkg;
+use FS::cust_pay;
+use FS::cust_credit;
+use FS::part_referral;
+use FS::cust_main_county;
+use FS::agent;
+use FS::cust_main_invoice;
+use FS::cust_credit_bill;
+use FS::cust_bill_pay;
+use FS::prepay_credit;
+use FS::queue;
+use FS::part_pkg;
+use FS::part_bill_event;
+use FS::cust_bill_event;
+use FS::cust_tax_exempt;
+use FS::Msgcat qw(gettext);
+
+@ISA = qw( FS::Record );
+
+$Debug = 0;
+#$Debug = 1;
+
+$import = 0;
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_main'} = sub {
+ $conf = new FS::Conf;
+ #yes, need it for stuff below (prolly should be cached)
+};
+
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ if ( exists $hashref->{'pkgnum'} ) {
+# #@{ $self->{'_pkgnum'} } = ();
+ my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
+ $self->{'_pkgnum'} = $subcache;
+ #push @{ $self->{'_pkgnum'} },
+ FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
+ }
+}
+
+=head1 NAME
+
+FS::cust_main - Object methods for cust_main records
+
+=head1 SYNOPSIS
+
+ use FS::cust_main;
+
+ $record = new FS::cust_main \%hash;
+ $record = new FS::cust_main { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ @cust_pkg = $record->all_pkgs;
+
+ @cust_pkg = $record->ncancelled_pkgs;
+
+ @cust_pkg = $record->suspended_pkgs;
+
+ $error = $record->bill;
+ $error = $record->bill %options;
+ $error = $record->bill 'time' => $time;
+
+ $error = $record->collect;
+ $error = $record->collect %options;
+ $error = $record->collect 'invoice_time' => $time,
+ 'batch_card' => 'yes',
+ 'report_badcard' => 'yes',
+ ;
+
+=head1 DESCRIPTION
+
+An FS::cust_main object represents a customer. FS::cust_main inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item custnum - primary key (assigned automatically for new customers)
+
+=item agentnum - agent (see L<FS::agent>)
+
+=item refnum - Advertising source (see L<FS::part_referral>)
+
+=item first - name
+
+=item last - name
+
+=item ss - social security number (optional)
+
+=item company - (optional)
+
+=item address1
+
+=item address2 - (optional)
+
+=item city
+
+=item county - (optional, see L<FS::cust_main_county>)
+
+=item state - (see L<FS::cust_main_county>)
+
+=item zip
+
+=item country - (see L<FS::cust_main_county>)
+
+=item daytime - phone (optional)
+
+=item night - phone (optional)
+
+=item fax - phone (optional)
+
+=item ship_first - name
+
+=item ship_last - name
+
+=item ship_company - (optional)
+
+=item ship_address1
+
+=item ship_address2 - (optional)
+
+=item ship_city
+
+=item ship_county - (optional, see L<FS::cust_main_county>)
+
+=item ship_state - (see L<FS::cust_main_county>)
+
+=item ship_zip
+
+=item ship_country - (see L<FS::cust_main_county>)
+
+=item ship_daytime - phone (optional)
+
+=item ship_night - phone (optional)
+
+=item ship_fax - phone (optional)
+
+=item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
+
+=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
+
+=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
+
+=item payname - name on card or billing name
+
+=item tax - tax exempt, empty or `Y'
+
+=item otaker - order taker (assigned automatically, see L<FS::UID>)
+
+=item comments - comments (optional)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new customer. To add the customer to the database, see L<"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 I<hash> method.
+
+=cut
+
+sub table { 'cust_main'; }
+
+=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ]
+
+Adds this customer to the database. If there is an error, returns the error,
+otherwise returns false.
+
+CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
+are inserted atomicly, or the transaction is rolled back. Passing an empty
+hash reference is equivalent to not supplying this parameter. There should be
+a better explanation of this, but until then, here's an example:
+
+ use Tie::RefHash;
+ tie %hash, 'Tie::RefHash'; #this part is important
+ %hash = (
+ $cust_pkg => [ $svc_acct ],
+ ...
+ );
+ $cust_main->insert( \%hash );
+
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. The invoicing_list is set after the records in the
+CUST_PKG_HASHREF above are inserted, so it is now possible to set an
+invoicing_list destination to the newly-created svc_acct. Here's an example:
+
+ $cust_main->insert( {}, [ $email, 'POST' ] );
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my @param = @_;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $amount = 0;
+ my $seconds = 0;
+ if ( $self->payby eq 'PREPAY' ) {
+ $self->payby('BILL');
+ my $prepay_credit = qsearchs(
+ 'prepay_credit',
+ { 'identifier' => $self->payinfo },
+ '',
+ 'FOR UPDATE'
+ );
+ warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
+ unless $prepay_credit;
+ $amount = $prepay_credit->amount;
+ $seconds = $prepay_credit->seconds;
+ my $error = $prepay_credit->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "removing prepay_credit (transaction rolled back): $error";
+ }
+ }
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ #return "inserting cust_main record (transaction rolled back): $error";
+ return $error;
+ }
+
+ if ( @param ) { # CUST_PKG_HASHREF
+ my $cust_pkgs = shift @param;
+ foreach my $cust_pkg ( keys %$cust_pkgs ) {
+ $cust_pkg->custnum( $self->custnum );
+ $error = $cust_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting cust_pkg (transaction rolled back): $error";
+ }
+ foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
+ $svc_something->pkgnum( $cust_pkg->pkgnum );
+ if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
+ $svc_something->seconds( $svc_something->seconds + $seconds );
+ $seconds = 0;
+ }
+ $error = $svc_something->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ #return "inserting svc_ (transaction rolled back): $error";
+ return $error;
+ }
+ }
+ }
+ }
+
+ if ( $seconds ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "No svc_acct record to apply pre-paid time";
+ }
+
+ if ( @param ) { # INVOICING_LIST_ARYREF
+ my $invoicing_list = shift @param;
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "checking invoicing_list (transaction rolled back): $error";
+ }
+ $self->invoicing_list( $invoicing_list );
+ }
+
+ if ( $amount ) {
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ };
+ $error = $cust_credit->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting credit (transaction rolled back): $error";
+ }
+ }
+
+ #false laziness with sub replace
+ my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+
+ if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
+ $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+ #eslaf
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item delete NEW_CUSTNUM
+
+This deletes the customer. If there is an error, returns the error, otherwise
+returns false.
+
+This will completely remove all traces of the customer record. This is not
+what you want when a customer cancels service; for that, cancel all of the
+customer's packages (see L<FS::cust_pkg/cancel>).
+
+If the customer has any uncancelled packages, you need to pass a new (valid)
+customer number for those packages to be transferred to. Cancelled packages
+will be deleted. Did I mention that this is NOT what you want when a customer
+cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
+
+You can't delete a customer with invoices (see L<FS::cust_bill>),
+or credits (see L<FS::cust_credit>), payments (see L<FS::cust_pay>) or
+refunds (see L<FS::cust_refund>).
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with invoices";
+ }
+ if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with credits";
+ }
+ if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with payments";
+ }
+ if ( qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with refunds";
+ }
+
+ my @cust_pkg = $self->ncancelled_pkgs;
+ if ( @cust_pkg ) {
+ my $new_custnum = shift;
+ unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Invalid new customer number: $new_custnum";
+ }
+ foreach my $cust_pkg ( @cust_pkg ) {
+ my %hash = $cust_pkg->hash;
+ $hash{'custnum'} = $new_custnum;
+ my $new_cust_pkg = new FS::cust_pkg ( \%hash );
+ my $error = $new_cust_pkg->replace($cust_pkg);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+ my @cancelled_cust_pkg = $self->all_pkgs;
+ foreach my $cust_pkg ( @cancelled_cust_pkg ) {
+ my $error = $cust_pkg->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ foreach my $cust_main_invoice ( #(email invoice destinations, not invoices)
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
+ ) {
+ my $error = $cust_main_invoice->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ]
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. Here's an example:
+
+ $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+
+=cut
+
+sub replace {
+ my $self = shift;
+ my $old = shift;
+ my @param = @_;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::replace($old);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( @param ) { # INVOICING_LIST_ARYREF
+ my $invoicing_list = shift @param;
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $self->invoicing_list( $invoicing_list );
+ }
+
+ #false laziness with sub insert
+ my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+
+ if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) {
+ $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
+ $error = $queue->insert($self->getfield('last'), $self->company);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+ #eslaf
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item check
+
+Checks all fields to make sure this is a valid customer record. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and repalce methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ #warn "BEFORE: \n". $self->_dump;
+
+ my $error =
+ $self->ut_numbern('custnum')
+ || $self->ut_number('agentnum')
+ || $self->ut_number('refnum')
+ || $self->ut_name('last')
+ || $self->ut_name('first')
+ || $self->ut_textn('company')
+ || $self->ut_text('address1')
+ || $self->ut_textn('address2')
+ || $self->ut_text('city')
+ || $self->ut_textn('county')
+ || $self->ut_textn('state')
+ || $self->ut_country('country')
+ || $self->ut_anything('comments')
+ || $self->ut_numbern('referral_custnum')
+ ;
+ #barf. need message catalogs. i18n. etc.
+ $error .= "Please select a advertising source."
+ if $error =~ /^Illegal or empty \(numeric\) refnum: /;
+ return $error if $error;
+
+ return "Unknown agent"
+ unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
+
+ return "Unknown refnum"
+ unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
+
+ return "Unknown referring custnum ". $self->referral_custnum
+ unless ! $self->referral_custnum
+ || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
+
+ if ( $self->ss eq '' ) {
+ $self->ss('');
+ } else {
+ my $ss = $self->ss;
+ $ss =~ s/\D//g;
+ $ss =~ /^(\d{3})(\d{2})(\d{4})$/
+ or return "Illegal social security number: ". $self->ss;
+ $self->ss("$1-$2-$3");
+ }
+
+
+# bad idea to disable, causes billing to fail because of no tax rates later
+# unless ( $import ) {
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown state/county/country: ".
+ $self->state. "/". $self->county. "/". $self->country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ } );
+ }
+# }
+
+ $error =
+ $self->ut_phonen('daytime', $self->country)
+ || $self->ut_phonen('night', $self->country)
+ || $self->ut_phonen('fax', $self->country)
+ || $self->ut_zip('zip', $self->country)
+ ;
+ return $error if $error;
+
+ my @addfields = qw(
+ last first company address1 address2 city county state zip
+ country daytime night fax
+ );
+
+ if ( defined $self->dbdef_table->column('ship_last') ) {
+ if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
+ @addfields )
+ && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields )
+ )
+ {
+ my $error =
+ $self->ut_name('ship_last')
+ || $self->ut_name('ship_first')
+ || $self->ut_textn('ship_company')
+ || $self->ut_text('ship_address1')
+ || $self->ut_textn('ship_address2')
+ || $self->ut_text('ship_city')
+ || $self->ut_textn('ship_county')
+ || $self->ut_textn('ship_state')
+ || $self->ut_country('ship_country')
+ ;
+ return $error if $error;
+
+ #false laziness with above
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->ship_country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown ship_state/ship_county/ship_country: ".
+ $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->ship_state,
+ 'county' => $self->ship_county,
+ 'country' => $self->ship_country,
+ } );
+ }
+ #eofalse
+
+ $error =
+ $self->ut_phonen('ship_daytime', $self->ship_country)
+ || $self->ut_phonen('ship_night', $self->ship_country)
+ || $self->ut_phonen('ship_fax', $self->ship_country)
+ || $self->ut_zip('ship_zip', $self->ship_country)
+ ;
+ return $error if $error;
+
+ } else { # ship_ info eq billing info, so don't store dup info in database
+ $self->setfield("ship_$_", '')
+ foreach qw( last first company address1 address2 city county state zip
+ country daytime night fax );
+ }
+ }
+
+ $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
+ or return "Illegal payby: ". $self->payby;
+ $self->payby($1);
+
+ if ( $self->payby eq 'CARD' ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+ $payinfo =~ /^(\d{13,16})$/
+ or return gettext('invalid_card'); # . ": ". $self->payinfo;
+ $payinfo = $1;
+ $self->payinfo($payinfo);
+ validate($payinfo)
+ or return gettext('invalid_card'); # . ": ". $self->payinfo;
+ return gettext('unknown_card_type')
+ if cardtype($self->payinfo) eq "Unknown";
+
+ } elsif ( $self->payby eq 'BILL' ) {
+
+ $error = $self->ut_textn('payinfo');
+ return "Illegal P.O. number: ". $self->payinfo if $error;
+
+ } elsif ( $self->payby eq 'COMP' ) {
+
+ $error = $self->ut_textn('payinfo');
+ return "Illegal comp account issuer: ". $self->payinfo if $error;
+
+ } elsif ( $self->payby eq 'PREPAY' ) {
+
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\W//g; #anything else would just confuse things
+ $self->payinfo($payinfo);
+ $error = $self->ut_alpha('payinfo');
+ return "Illegal prepayment identifier: ". $self->payinfo if $error;
+ return "Unknown prepayment identifier"
+ unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+
+ }
+
+ if ( $self->paydate eq '' || $self->paydate eq '-' ) {
+ return "Expriation date required"
+ unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
+ $self->paydate('');
+ } else {
+ $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
+ or return "Illegal expiration date: ". $self->paydate;
+ my $y = length($2) == 4 ? $2 : "20$2";
+ $self->paydate("$y-$1-01");
+ my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
+ return gettext('expired_card') if $y<$nowy || ( $y==$nowy && $1<$nowm );
+ }
+
+ if ( $self->payname eq '' &&
+ ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) {
+ $self->payname( $self->first. " ". $self->getfield('last') );
+ } else {
+ $self->payname =~ /^([\w \,\.\-\']+)$/
+ or return gettext('illegal_name'). " payname: ". $self->payname;
+ $self->payname($1);
+ }
+
+ $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
+ $self->tax($1);
+
+ $self->otaker(getotaker);
+
+ #warn "AFTER: \n". $self->_dump;
+
+ ''; #no error
+}
+
+=item all_pkgs
+
+Returns all packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub all_pkgs {
+ my $self = shift;
+ if ( $self->{'_pkgnum'} ) {
+ values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ }
+}
+
+=item ncancelled_pkgs
+
+Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub ncancelled_pkgs {
+ my $self = shift;
+ if ( $self->{'_pkgnum'} ) {
+ grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ @{ [ # force list context
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => '',
+ }),
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => 0,
+ }),
+ ] };
+ }
+}
+
+=item suspended_pkgs
+
+Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
+
+=cut
+
+sub suspended_pkgs {
+ my $self = shift;
+ grep { $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unflagged_suspended_pkgs
+
+Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
+customer (thouse packages without the `manual_flag' set).
+
+=cut
+
+sub unflagged_suspended_pkgs {
+ my $self = shift;
+ return $self->suspended_pkgs
+ unless dbdef->table('cust_pkg')->column('manual_flag');
+ grep { ! $_->manual_flag } $self->suspended_pkgs;
+}
+
+=item unsuspended_pkgs
+
+Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
+this customer.
+
+=cut
+
+sub unsuspended_pkgs {
+ my $self = shift;
+ grep { ! $_->susp } $self->ncancelled_pkgs;
+}
+
+=item unsuspend
+
+Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
+and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
+on success or a list of errors.
+
+=cut
+
+sub unsuspend {
+ my $self = shift;
+ grep { $_->unsuspend } $self->suspended_pkgs;
+}
+
+=item suspend
+
+Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub suspend {
+ my $self = shift;
+ grep { $_->suspend } $self->unsuspended_pkgs;
+}
+
+=item cancel
+
+Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
+Always returns a list: an empty list on success or a list of errors.
+
+=cut
+
+sub cancel {
+ my $self = shift;
+ grep { $_->cancel } $self->ncancelled_pkgs;
+}
+
+=item agent
+
+Returns the agent (see L<FS::agent>) for this customer.
+
+=cut
+
+sub agent {
+ my $self = shift;
+ qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
+}
+
+=item bill OPTIONS
+
+Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
+conjunction with the collect method.
+
+Options are passed as name-value pairs.
+
+The only currently available option is `time', which bills the customer as if
+it were that time. It is specified as a UNIX timestamp; see
+L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
+functions. For example:
+
+ use Date::Parse;
+ ...
+ $cust_main->bill( 'time' => str2time('April 20th, 2001') );
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub bill {
+ my( $self, %options ) = @_;
+ my $time = $options{'time'} || time;
+
+ my $error;
+
+ #put below somehow?
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ # find the packages which are due for billing, find out how much they are
+ # & generate invoice database.
+
+ my( $total_setup, $total_recur ) = ( 0, 0 );
+ #my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
+ my @cust_bill_pkg = ();
+ my $tax = 0;##
+ #my $taxable_charged = 0;##
+ #my $charged = 0;##
+
+ foreach my $cust_pkg (
+ qsearch('cust_pkg', { 'custnum' => $self->custnum } )
+ ) {
+
+ #NO!! next if $cust_pkg->cancel;
+ next if $cust_pkg->getfield('cancel');
+
+ #? to avoid use of uninitialized value errors... ?
+ $cust_pkg->setfield('bill', '')
+ unless defined($cust_pkg->bill);
+
+ my $part_pkg = $cust_pkg->part_pkg;
+
+ #so we don't modify cust_pkg record unnecessarily
+ my $cust_pkg_mod_flag = 0;
+ my %hash = $cust_pkg->hash;
+ my $old_cust_pkg = new FS::cust_pkg \%hash;
+
+ # bill setup
+ my $setup = 0;
+ unless ( $cust_pkg->setup ) {
+ my $setup_prog = $part_pkg->getfield('setup');
+ $setup_prog =~ /^(.*)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal setup for pkgpart ". $part_pkg->pkgpart.
+ ": $setup_prog";
+ };
+ $setup_prog = $1;
+
+ #my $cpt = new Safe;
+ ##$cpt->permit(); #what is necessary?
+ #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+ #$setup = $cpt->reval($setup_prog);
+ $setup = eval $setup_prog;
+ unless ( defined($setup) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
+ "(expression $setup_prog): $@";
+ }
+ $cust_pkg->setfield('setup',$time);
+ $cust_pkg_mod_flag=1;
+ }
+
+ #bill recurring fee
+ my $recur = 0;
+ my $sdate;
+ if ( $part_pkg->getfield('freq') > 0 &&
+ ! $cust_pkg->getfield('susp') &&
+ ( $cust_pkg->getfield('bill') || 0 ) < $time
+ ) {
+ my $recur_prog = $part_pkg->getfield('recur');
+ $recur_prog =~ /^(.*)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal recur for pkgpart ". $part_pkg->pkgpart.
+ ": $recur_prog";
+ };
+ $recur_prog = $1;
+
+ # shared with $recur_prog
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+
+ #my $cpt = new Safe;
+ ##$cpt->permit(); #what is necessary?
+ #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+ #$recur = $cpt->reval($recur_prog);
+ $recur = eval $recur_prog;
+ unless ( defined($recur) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
+ "(expression $recur_prog): $@";
+ }
+ #change this bit to use Date::Manip? CAREFUL with timezones (see
+ # mailing list archive)
+ my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($sdate) )[0,1,2,3,4,5];
+
+ #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
+ # only for figuring next bill date, nothing else, so, reset $sdate again
+ # here
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+
+ $mon += $part_pkg->freq;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ $cust_pkg->setfield('bill',
+ timelocal($sec,$min,$hour,$mday,$mon,$year));
+ $cust_pkg_mod_flag = 1;
+ }
+
+ warn "\$setup is undefined" unless defined($setup);
+ warn "\$recur is undefined" unless defined($recur);
+ warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
+
+ my $taxable_charged = 0;
+ if ( $cust_pkg_mod_flag ) {
+ $error=$cust_pkg->replace($old_cust_pkg);
+ if ( $error ) { #just in case
+ $dbh->rollback if $oldAutoCommit;
+ return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error";
+ }
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ if ( $setup < 0 ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $recur < 0 ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $setup > 0 || $recur > 0 ) {
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'recur' => $recur,
+ 'sdate' => $sdate,
+ 'edate' => $cust_pkg->bill,
+ });
+ push @cust_bill_pkg, $cust_bill_pkg;
+ $total_setup += $setup;
+ $total_recur += $recur;
+ $taxable_charged += $setup
+ unless $part_pkg->setuptax =~ /^Y$/i;
+ $taxable_charged += $recur
+ unless $part_pkg->recurtax =~ /^Y$/i;
+
+ unless ( $self->tax =~ /Y/i
+ || $self->payby eq 'COMP'
+ || $taxable_charged == 0 ) {
+
+ my $cust_main_county =
+ qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ 'taxclass' => $part_pkg->taxclass,
+ } )
+ or qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ 'taxclass' => '',
+ } )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return
+ "fatal: can't find tax rate for state/county/country/taxclass ".
+ join('/', map $self->$_(), qw(state county country taxclass) ).
+ "\n";
+ };
+
+ if ( $cust_main_county->exempt_amount ) {
+ my ($mon,$year) = (localtime($sdate) )[4,5];
+ $mon++;
+ my $freq = $part_pkg->freq || 1;
+ my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq );
+ foreach my $which_month ( 1 .. $freq ) {
+ my %hash = (
+ 'custnum' => $self->custnum,
+ 'taxnum' => $cust_main_county->taxnum,
+ 'year' => 1900+$year,
+ 'month' => $mon++,
+ );
+ #until ( $mon < 12 ) { $mon -= 12; $year++; }
+ until ( $mon < 13 ) { $mon -= 12; $year++; }
+ my $cust_tax_exempt =
+ qsearchs('cust_tax_exempt', \%hash)
+ || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } );
+ my $remaining_exemption = sprintf("%.2f",
+ $cust_main_county->exempt_amount - $cust_tax_exempt->amount );
+ if ( $remaining_exemption > 0 ) {
+ my $addl = $remaining_exemption > $taxable_per_month
+ ? $taxable_per_month
+ : $remaining_exemption;
+ $taxable_charged -= $addl;
+ my $new_cust_tax_exempt = new FS::cust_tax_exempt ( {
+ $cust_tax_exempt->hash,
+ 'amount' => sprintf("%.2f", $cust_tax_exempt->amount + $addl),
+ } );
+ $error = $new_cust_tax_exempt->exemptnum
+ ? $new_cust_tax_exempt->replace($cust_tax_exempt)
+ : $new_cust_tax_exempt->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "fatal: can't update cust_tax_exempt: $error";
+ }
+
+ } # if $remaining_exemption > 0
+
+ } #foreach $which_month
+
+ } #if $cust_main_county->exempt_amount
+
+ $taxable_charged = sprintf( "%.2f", $taxable_charged);
+ $tax += $taxable_charged * $cust_main_county->tax / 100
+
+ } #unless $self->tax =~ /Y/i
+ # || $self->payby eq 'COMP'
+ # || $taxable_charged == 0
+
+ } #if $setup > 0 || $recur > 0
+
+ } #if $cust_pkg_mod_flag
+
+ } #foreach my $cust_pkg
+
+ my $charged = sprintf( "%.2f", $total_setup + $total_recur );
+# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
+
+ unless ( @cust_bill_pkg ) { #don't create invoices with no line items
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+# unless ( $self->tax =~ /Y/i
+# || $self->payby eq 'COMP'
+# || $taxable_charged == 0 ) {
+# my $cust_main_county = qsearchs('cust_main_county',{
+# 'state' => $self->state,
+# 'county' => $self->county,
+# 'country' => $self->country,
+# } ) or die "fatal: can't find tax rate for state/county/country ".
+# $self->state. "/". $self->county. "/". $self->country. "\n";
+# my $tax = sprintf( "%.2f",
+# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
+# );
+
+ $tax = sprintf("%.2f", $tax);
+ if ( $tax > 0 ) {
+ $charged = sprintf( "%.2f", $charged+$tax );
+
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ });
+ push @cust_bill_pkg, $cust_bill_pkg;
+ }
+# }
+
+ my $cust_bill = new FS::cust_bill ( {
+ 'custnum' => $self->custnum,
+ '_date' => $time,
+ 'charged' => $charged,
+ } );
+ $error = $cust_bill->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice for customer #". $self->custnum. ": $error";
+ }
+
+ my $invnum = $cust_bill->invnum;
+ my $cust_bill_pkg;
+ foreach $cust_bill_pkg ( @cust_bill_pkg ) {
+ #warn $invnum;
+ $cust_bill_pkg->invnum($invnum);
+ $error = $cust_bill_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice line item for customer #". $self->custnum.
+ ": $error";
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
+
+=item collect OPTIONS
+
+(Attempt to) collect money for this customer's outstanding invoices (see
+L<FS::cust_bill>). Usually used after the bill method.
+
+Depending on the value of `payby', this may print an invoice (`BILL'), charge
+a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
+
+Most actions are now triggered by invoice events; see L<FS::part_bill_event>
+and the invoice events web interface.
+
+If there is an error, returns the error, otherwise returns false.
+
+Options are passed as name-value pairs.
+
+Currently available options are:
+
+invoice_time - Use this time when deciding when to print invoices and
+late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
+for conversion functions.
+
+batch_card - This option is deprecated. See the invoice events web interface
+to control whether cards are batched or run against a realtime gateway.
+
+report_badcard - This option is deprecated.
+
+force_print - This option is deprecated; see the invoice events web interface.
+
+=cut
+
+sub collect {
+ my( $self, %options ) = @_;
+ my $invoice_time = $options{'invoice_time'} || time;
+
+ #put below somehow?
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $balance = $self->balance;
+ warn "collect customer". $self->custnum. ": balance $balance" if $Debug;
+ unless ( $balance > 0 ) { #redundant?????
+ $dbh->rollback if $oldAutoCommit; #hmm
+ return '';
+ }
+
+ foreach my $cust_bill (
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
+
+ #this has to be before next's
+ my $amount = sprintf( "%.2f", $balance < $cust_bill->owed
+ ? $balance
+ : $cust_bill->owed
+ );
+ $balance = sprintf( "%.2f", $balance - $amount );
+
+ next unless $cust_bill->owed > 0;
+
+ # don't try to charge for the same invoice if it's already in a batch
+ #next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
+
+ warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug;
+
+ next unless $amount > 0;
+
+ foreach my $part_bill_event (
+ sort { $a->seconds <=> $b->seconds
+ || $a->weight <=> $b->weight
+ || $a->eventpart <=> $b->eventpart }
+ grep { $_->seconds <= ( $invoice_time - $cust_bill->_date )
+ && ! qsearchs( 'cust_bill_event', {
+ 'invnum' => $cust_bill->invnum,
+ 'eventpart' => $_->eventpart,
+ 'status' => 'done',
+ } )
+ }
+ qsearch('part_bill_event', { 'payby' => $self->payby,
+ 'disabled' => '', } )
+ ) {
+
+ last unless $cust_bill->owed > 0; #don't run subsequent events if owed=0
+
+ warn "calling invoice event (". $part_bill_event->eventcode. ")\n"
+ if $Debug;
+ my $cust_main = $self; #for callback
+ my $error = eval $part_bill_event->eventcode;
+
+ my $status = '';
+ my $statustext = '';
+ if ( $@ ) {
+ $status = 'failed';
+ $statustext = $@;
+ } elsif ( $error ) {
+ $status = 'done';
+ $statustext = $error;
+ } else {
+ $status = 'done'
+ }
+
+ #add cust_bill_event
+ my $cust_bill_event = new FS::cust_bill_event {
+ 'invnum' => $cust_bill->invnum,
+ 'eventpart' => $part_bill_event->eventpart,
+ '_date' => $invoice_time,
+ 'status' => $status,
+ 'statustext' => $statustext,
+ };
+ $error = $cust_bill_event->insert;
+ if ( $error ) {
+ #$dbh->rollback if $oldAutoCommit;
+ #return "error: $error";
+
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ my $e = 'WARNING: Event run but database not updated - '.
+ 'error inserting cust_bill_event, invnum #'. $cust_bill->invnum.
+ ', eventpart '. $part_bill_event->eventpart.
+ ": $error";
+ warn $e;
+ return $e;
+ }
+
+
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item total_owed
+
+Returns the total owed for this customer on all invoices
+(see L<FS::cust_bill/owed>).
+
+=cut
+
+sub total_owed {
+ my $self = shift;
+ $self->total_owed_date(2145859200); #12/31/2037
+}
+
+=item total_owed_date TIME
+
+Returns the total owed for this customer on all invoices with date earlier than
+TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
+see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub total_owed_date {
+ my $self = shift;
+ my $time = shift;
+ my $total_bill = 0;
+ foreach my $cust_bill (
+ grep { $_->_date <= $time }
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
+ $total_bill += $cust_bill->owed;
+ }
+ sprintf( "%.2f", $total_bill );
+}
+
+=item apply_credits
+
+Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
+to outstanding invoice balances in chronological order and returns the value
+of any remaining unapplied credits available for refund
+(see L<FS::cust_refund>).
+
+=cut
+
+sub apply_credits {
+ my $self = shift;
+
+ return 0 unless $self->total_credited;
+
+ my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
+ qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
+
+ my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
+ qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+
+ my $credit;
+
+ foreach my $cust_bill ( @invoices ) {
+ my $amount;
+
+ if ( !defined($credit) || $credit->credited == 0) {
+ $credit = pop @credits or last;
+ }
+
+ if ($cust_bill->owed >= $credit->credited) {
+ $amount=$credit->credited;
+ }else{
+ $amount=$cust_bill->owed;
+ }
+
+ my $cust_credit_bill = new FS::cust_credit_bill ( {
+ 'crednum' => $credit->crednum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ my $error = $cust_credit_bill->insert;
+ die $error if $error;
+
+ redo if ($cust_bill->owed > 0);
+
+ }
+
+ return $self->total_credited;
+}
+
+=item apply_payments
+
+Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
+to outstanding invoice balances in chronological order.
+
+ #and returns the value of any remaining unapplied payments.
+
+=cut
+
+sub apply_payments {
+ my $self = shift;
+
+ #return 0 unless
+
+ my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
+ qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
+
+ my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
+ qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+
+ my $payment;
+
+ foreach my $cust_bill ( @invoices ) {
+ my $amount;
+
+ if ( !defined($payment) || $payment->unapplied == 0 ) {
+ $payment = pop @payments or last;
+ }
+
+ if ( $cust_bill->owed >= $payment->unapplied ) {
+ $amount = $payment->unapplied;
+ } else {
+ $amount = $cust_bill->owed;
+ }
+
+ my $cust_bill_pay = new FS::cust_bill_pay ( {
+ 'paynum' => $payment->paynum,
+ 'invnum' => $cust_bill->invnum,
+ 'amount' => $amount,
+ } );
+ my $error = $cust_bill_pay->insert;
+ die $error if $error;
+
+ redo if ( $cust_bill->owed > 0);
+
+ }
+
+ return $self->total_unapplied_payments;
+}
+
+=item total_credited
+
+Returns the total outstanding credit (see L<FS::cust_credit>) for this
+customer. See L<FS::cust_credit/credited>.
+
+=cut
+
+sub total_credited {
+ my $self = shift;
+ my $total_credit = 0;
+ foreach my $cust_credit ( qsearch('cust_credit', {
+ 'custnum' => $self->custnum,
+ } ) ) {
+ $total_credit += $cust_credit->credited;
+ }
+ sprintf( "%.2f", $total_credit );
+}
+
+=item total_unapplied_payments
+
+Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
+See L<FS::cust_pay/unapplied>.
+
+=cut
+
+sub total_unapplied_payments {
+ my $self = shift;
+ my $total_unapplied = 0;
+ foreach my $cust_pay ( qsearch('cust_pay', {
+ 'custnum' => $self->custnum,
+ } ) ) {
+ $total_unapplied += $cust_pay->unapplied;
+ }
+ sprintf( "%.2f", $total_unapplied );
+}
+
+=item balance
+
+Returns the balance for this customer (total_owed minus total_credited
+minus total_unapplied_payments).
+
+=cut
+
+sub balance {
+ my $self = shift;
+ sprintf( "%.2f",
+ $self->total_owed - $self->total_credited - $self->total_unapplied_payments
+ );
+}
+
+=item balance_date TIME
+
+Returns the balance for this customer, only considering invoices with date
+earlier than TIME (total_owed_date minus total_credited minus
+total_unapplied_payments). TIME is specified as a UNIX timestamp; see
+L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub balance_date {
+ my $self = shift;
+ my $time = shift;
+ sprintf( "%.2f",
+ $self->total_owed_date($time)
+ - $self->total_credited
+ - $self->total_unapplied_payments
+ );
+}
+
+=item invoicing_list [ ARRAYREF ]
+
+If an arguement is given, sets these email addresses as invoice recipients
+(see L<FS::cust_main_invoice>). 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.
+
+This interface may change in the future.
+
+=cut
+
+sub invoicing_list {
+ my( $self, $arrayref ) = @_;
+ if ( $arrayref ) {
+ my @cust_main_invoice;
+ if ( $self->custnum ) {
+ @cust_main_invoice =
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+ } else {
+ @cust_main_invoice = ();
+ }
+ foreach my $cust_main_invoice ( @cust_main_invoice ) {
+ #warn $cust_main_invoice->destnum;
+ unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
+ #warn $cust_main_invoice->destnum;
+ my $error = $cust_main_invoice->delete;
+ warn $error if $error;
+ }
+ }
+ if ( $self->custnum ) {
+ @cust_main_invoice =
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+ } else {
+ @cust_main_invoice = ();
+ }
+ my %seen = map { $_->address => 1 } @cust_main_invoice;
+ foreach my $address ( @{$arrayref} ) {
+ #unless ( grep { $address eq $_->address } @cust_main_invoice ) {
+ next if exists $seen{$address} && $seen{$address};
+ $seen{$address} = 1;
+ my $cust_main_invoice = new FS::cust_main_invoice ( {
+ 'custnum' => $self->custnum,
+ 'dest' => $address,
+ } );
+ my $error = $cust_main_invoice->insert;
+ warn $error if $error;
+ }
+ }
+ if ( $self->custnum ) {
+ map { $_->address }
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
+ } else {
+ ();
+ }
+}
+
+=item 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.
+
+=cut
+
+sub check_invoicing_list {
+ my( $self, $arrayref ) = @_;
+ foreach my $address ( @{$arrayref} ) {
+ my $cust_main_invoice = new FS::cust_main_invoice ( {
+ 'custnum' => $self->custnum,
+ 'dest' => $address,
+ } );
+ my $error = $self->custnum
+ ? $cust_main_invoice->check
+ : $cust_main_invoice->checkdest
+ ;
+ return $error if $error;
+ }
+ '';
+}
+
+=item default_invoicing_list
+
+Sets the invoicing list to all accounts associated with this customer.
+
+=cut
+
+sub default_invoicing_list {
+ my $self = shift;
+ my @list = ();
+ foreach my $cust_pkg ( $self->all_pkgs ) {
+ my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ @cust_svc;
+ push @list, map { $_->email } @svc_acct;
+ }
+ $self->invoicing_list(\@list);
+}
+
+=item invoicing_list_addpost
+
+Adds postal invoicing to this customer. If this customer is already configured
+to receive postal invoices, does nothing.
+
+=cut
+
+sub invoicing_list_addpost {
+ my $self = shift;
+ return if grep { $_ eq 'POST' } $self->invoicing_list;
+ my @invoicing_list = $self->invoicing_list;
+ push @invoicing_list, 'POST';
+ $self->invoicing_list(\@invoicing_list);
+}
+
+=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
+
+Returns an array of customers referred by this customer (referral_custnum set
+to this custnum). If DEPTH is given, recurses up to the given depth, returning
+customers referred by customers referred by this customer and so on, inclusive.
+The default behavior is DEPTH 1 (no recursion).
+
+=cut
+
+sub referral_cust_main {
+ my $self = shift;
+ my $depth = @_ ? shift : 1;
+ my $exclude = @_ ? shift : {};
+
+ my @cust_main =
+ map { $exclude->{$_->custnum}++; $_; }
+ grep { ! $exclude->{ $_->custnum } }
+ qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
+
+ if ( $depth > 1 ) {
+ push @cust_main,
+ map { $_->referral_cust_main($depth-1, $exclude) }
+ @cust_main;
+ }
+
+ @cust_main;
+}
+
+=item referral_cust_main_ncancelled
+
+Same as referral_cust_main, except only returns customers with uncancelled
+packages.
+
+=cut
+
+sub referral_cust_main_ncancelled {
+ my $self = shift;
+ grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
+}
+
+=item referral_cust_pkg [ DEPTH ]
+
+Like referral_cust_main, except returns a flat list of all unsuspended (and
+uncancelled) packages for each customer. The number of items in this list may
+be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
+
+=cut
+
+sub referral_cust_pkg {
+ my $self = shift;
+ my $depth = @_ ? shift : 1;
+
+ map { $_->unsuspended_pkgs }
+ grep { $_->unsuspended_pkgs }
+ $self->referral_cust_main($depth);
+}
+
+=item credit AMOUNT, REASON
+
+Applies a credit to this customer. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+sub credit {
+ my( $self, $amount, $reason ) = @_;
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ 'reason' => $reason,
+ };
+ $cust_credit->insert;
+}
+
+=item charge AMOUNT PKG COMMENT
+
+Creates a one-time charge for this customer. If there is an error, returns
+the error, otherwise returns false.
+
+=cut
+
+sub charge {
+ my ( $self, $amount, $pkg, $comment ) = @_;
+
+ my $part_pkg = new FS::part_pkg ( {
+ 'pkg' => $pkg || 'One-time charge',
+ 'comment' => $comment || '$'. sprintf("%.2f".$amount),
+ 'setup' => $amount,
+ 'freq' => 0,
+ 'recur' => '0',
+ 'disabled' => 'Y',
+ } );
+
+ $part_pkg->insert;
+
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item check_and_rebuild_fuzzyfiles
+
+=cut
+
+sub check_and_rebuild_fuzzyfiles {
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ -e "$dir/cust_main.last" && -e "$dir/cust_main.company"
+ or &rebuild_fuzzyfiles;
+}
+
+=item rebuild_fuzzyfiles
+
+=cut
+
+sub rebuild_fuzzyfiles {
+
+ use Fcntl qw(:flock);
+
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+
+ #last
+
+ open(LASTLOCK,">>$dir/cust_main.last")
+ or die "can't open $dir/cust_main.last: $!";
+ flock(LASTLOCK,LOCK_EX)
+ or die "can't lock $dir/cust_main.last: $!";
+
+ my @all_last = map $_->getfield('last'), qsearch('cust_main', {});
+ push @all_last,
+ grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{})
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ open (LASTCACHE,">$dir/cust_main.last.tmp")
+ or die "can't open $dir/cust_main.last.tmp: $!";
+ print LASTCACHE join("\n", @all_last), "\n";
+ close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!";
+
+ rename "$dir/cust_main.last.tmp", "$dir/cust_main.last";
+ close LASTLOCK;
+
+ #company
+
+ open(COMPANYLOCK,">>$dir/cust_main.company")
+ or die "can't open $dir/cust_main.company: $!";
+ flock(COMPANYLOCK,LOCK_EX)
+ or die "can't lock $dir/cust_main.company: $!";
+
+ my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{});
+ push @all_company,
+ grep $_ ne '', map $_->ship_company, qsearch('cust_main', {})
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ open (COMPANYCACHE,">$dir/cust_main.company.tmp")
+ or die "can't open $dir/cust_main.company.tmp: $!";
+ print COMPANYCACHE join("\n", @all_company), "\n";
+ close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!";
+
+ rename "$dir/cust_main.company.tmp", "$dir/cust_main.company";
+ close COMPANYLOCK;
+
+}
+
+=item all_last
+
+=cut
+
+sub all_last {
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ open(LASTCACHE,"<$dir/cust_main.last")
+ or die "can't open $dir/cust_main.last: $!";
+ my @array = map { chomp; $_; } <LASTCACHE>;
+ close LASTCACHE;
+ \@array;
+}
+
+=item all_company
+
+=cut
+
+sub all_company {
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ open(COMPANYCACHE,"<$dir/cust_main.company")
+ or die "can't open $dir/cust_main.last: $!";
+ my @array = map { chomp; $_; } <COMPANYCACHE>;
+ close COMPANYCACHE;
+ \@array;
+}
+
+=item append_fuzzyfiles LASTNAME COMPANY
+
+=cut
+
+sub append_fuzzyfiles {
+ my( $last, $company ) = @_;
+
+ &check_and_rebuild_fuzzyfiles;
+
+ use Fcntl qw(:flock);
+
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+
+ if ( $last ) {
+
+ open(LAST,">>$dir/cust_main.last")
+ or die "can't open $dir/cust_main.last: $!";
+ flock(LAST,LOCK_EX)
+ or die "can't lock $dir/cust_main.last: $!";
+
+ print LAST "$last\n";
+
+ flock(LAST,LOCK_UN)
+ or die "can't unlock $dir/cust_main.last: $!";
+ close LAST;
+ }
+
+ if ( $company ) {
+
+ open(COMPANY,">>$dir/cust_main.company")
+ or die "can't open $dir/cust_main.company: $!";
+ flock(COMPANY,LOCK_EX)
+ or die "can't lock $dir/cust_main.company: $!";
+
+ print COMPANY "$company\n";
+
+ flock(COMPANY,LOCK_UN)
+ or die "can't unlock $dir/cust_main.company: $!";
+
+ close COMPANY;
+ }
+
+ 1;
+}
+
+=back
+
+=head1 BUGS
+
+The delete method.
+
+The delete method should possibly take an FS::cust_main object reference
+instead of a scalar customer number.
+
+Bill and collect options should probably be passed as references instead of a
+list.
+
+There should probably be a configuration file with a list of allowed credit
+card types.
+
+No multiple currency support (probably a larger project than just this module).
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
+L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
+L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
+
+=cut
+
+1;
+
+
--- /dev/null
+package FS::cust_main_county;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK $conf
+ @cust_main_county %cust_main_county $countyflag );
+use Exporter;
+use FS::Record qw( qsearch );
+
+@ISA = qw( FS::Record );
+@EXPORT_OK = qw( regionselector );
+
+@cust_main_county = ();
+$countyflag = '';
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_main_county'} = sub {
+ $conf = new FS::Conf;
+};
+
+=head1 NAME
+
+FS::cust_main_county - Object methods for cust_main_county objects
+
+=head1 SYNOPSIS
+
+ use FS::cust_main_county;
+
+ $record = new FS::cust_main_county \%hash;
+ $record = new FS::cust_main_county { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ ($county_html, $state_html, $country_html) =
+ FS::cust_main_county::regionselector( $county, $state, $country );
+
+=head1 DESCRIPTION
+
+An FS::cust_main_county object represents a tax rate, defined by locale.
+FS::cust_main_county inherits from FS::Record. The following fields are
+currently supported:
+
+=over 4
+
+=item taxnum - primary key (assigned automatically for new tax rates)
+
+=item state
+
+=item county
+
+=item country
+
+=item tax - percentage
+
+=item taxclass
+
+=item exempt_amount
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_main_county'; }
+
+=item insert
+
+Adds this tax rate to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this tax rate from the database. If there is an error, returns the
+error, otherwise returns false.
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid tax rate. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->exempt_amount(0) unless $self->exempt_amount;
+
+ $self->ut_numbern('taxnum')
+ || $self->ut_textn('state')
+ || $self->ut_textn('county')
+ || $self->ut_text('country')
+ || $self->ut_float('tax')
+ || $self->ut_textn('taxclass') # ...
+ || $self->ut_money('exempt_amount')
+ ;
+
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item regionselector [ COUNTY STATE COUNTRY [ PREFIX [ ONCHANGE ] ] ]
+
+=cut
+
+sub regionselector {
+ my ( $selected_county, $selected_state, $selected_country,
+ $prefix, $onchange ) = @_;
+
+ $countyflag = 0;
+
+# unless ( @cust_main_county ) { #cache
+ @cust_main_county = qsearch('cust_main_county', {} );
+ foreach my $c ( @cust_main_county ) {
+ $countyflag=1 if $c->county;
+ #push @{$cust_main_county{$c->country}{$c->state}}, $c->county;
+ $cust_main_county{$c->country}{$c->state}{$c->county} = 1;
+ }
+# }
+ $countyflag=1 if $selected_county;
+
+ my $script_html = <<END;
+ <SCRIPT>
+ function opt(what,value,text) {
+ var optionName = new Option(text, value, false, false);
+ var length = what.length;
+ what.options[length] = optionName;
+ }
+ function ${prefix}country_changed(what) {
+ country = what.options[what.selectedIndex].text;
+ for ( var i = what.form.${prefix}state.length; i >= 0; i-- )
+ what.form.${prefix}state.options[i] = null;
+END
+ #what.form.${prefix}state.options[0] = new Option('', '', false, true);
+
+ foreach my $country ( sort keys %cust_main_county ) {
+ $script_html .= "\nif ( country == \"$country\" ) {\n";
+ foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
+ my $text = $state || '(n/a)';
+ $script_html .= qq!opt(what.form.${prefix}state, "$state", "$text");\n!;
+ }
+ $script_html .= "}\n";
+ }
+
+ $script_html .= <<END;
+ }
+ function ${prefix}state_changed(what) {
+END
+
+ if ( $countyflag ) {
+ $script_html .= <<END;
+ state = what.options[what.selectedIndex].text;
+ country = what.form.${prefix}country.options[what.form.${prefix}country.selectedIndex].text;
+ for ( var i = what.form.${prefix}county.length; i >= 0; i-- )
+ what.form.${prefix}county.options[i] = null;
+END
+
+ foreach my $country ( sort keys %cust_main_county ) {
+ $script_html .= "\nif ( country == \"$country\" ) {\n";
+ foreach my $state ( sort keys %{$cust_main_county{$country}} ) {
+ $script_html .= "\nif ( state == \"$state\" ) {\n";
+ #foreach my $county ( sort @{$cust_main_county{$country}{$state}} ) {
+ foreach my $county ( sort keys %{$cust_main_county{$country}{$state}} ) {
+ my $text = $county || '(n/a)';
+ $script_html .=
+ qq!opt(what.form.${prefix}county, "$county", "$text");\n!;
+ }
+ $script_html .= "}\n";
+ }
+ $script_html .= "}\n";
+ }
+ }
+
+ $script_html .= <<END;
+ }
+ </SCRIPT>
+END
+
+ my $county_html = $script_html;
+ if ( $countyflag ) {
+ $county_html .= qq!<SELECT NAME="${prefix}county" onChange="$onchange">!;
+ $county_html .= '</SELECT>';
+ } else {
+ $county_html .=
+ qq!<INPUT TYPE="hidden" NAME="${prefix}county" VALUE="$selected_county">!;
+ }
+
+ my $state_html = qq!<SELECT NAME="${prefix}state" !.
+ qq!onChange="${prefix}state_changed(this); $onchange">!;
+ foreach my $state ( sort keys %{ $cust_main_county{$selected_country} } ) {
+ my $text = $state || '(n/a)';
+ my $selected = $state eq $selected_state ? 'SELECTED' : '';
+ $state_html .= "\n<OPTION $selected VALUE=$state>$text</OPTION>"
+ }
+ $state_html .= '</SELECT>';
+
+ $state_html .= '</SELECT>';
+
+ my $country_html = qq!<SELECT NAME="${prefix}country" !.
+ qq!onChange="${prefix}country_changed(this); $onchange">!;
+ my $countrydefault = $conf->config('countrydefault') || 'US';
+ foreach my $country (
+ sort { ($b eq $countrydefault) <=> ($a eq $countrydefault) or $a cmp $b }
+ keys %cust_main_county
+ ) {
+ my $selected = $country eq $selected_country ? ' SELECTED' : '';
+ $country_html .= "\n<OPTION$selected>$country</OPTION>"
+ }
+ $country_html .= '</SELECT>';
+
+ ($county_html, $state_html, $country_html);
+
+}
+
+=back
+
+=head1 BUGS
+
+regionselector? putting web ui components in here? they should probably live
+somewhere else...
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_main_invoice;
+
+use strict;
+use vars qw(@ISA $conf);
+use Exporter;
+use FS::Record qw( qsearchs );
+use FS::Conf;
+use FS::cust_main;
+use FS::svc_acct;
+use FS::Msgcat qw(gettext);
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_main_invoice - Object methods for cust_main_invoice records
+
+=head1 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;
+
+=head1 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:
+
+=over 4
+
+=item destnum - primary key
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item dest - Invoice destination: If numeric, a svcnum (see L<FS::svc_acct>), if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new invoice destination. To add the invoice destination to the database, see L<"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 I<hash> method.
+
+=cut
+
+sub table { 'cust_main_invoice'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database.
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change custnum!" unless $old->custnum == $new->custnum;
+
+ $new->SUPER::replace($old);
+}
+
+
+=item 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.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error = $self->ut_numbern('destnum')
+ || $self->ut_number('custnum')
+ || $self->checkdest;
+ ;
+ return $error if $error;
+
+ return "Unknown customer"
+ unless qsearchs('cust_main',{ 'custnum' => $self->custnum });
+
+ ''; #noerror
+}
+
+=item checkdest
+
+Checks the dest field only.
+
+#If it finds that the account ends in the
+#same domain configured as the B<domain> configuration file, it will change the
+#invoice destination from an email address to a service number (see
+#L<FS::svc_acct>).
+
+=cut
+
+sub checkdest {
+ my $self = shift;
+
+ my $error = $self->ut_text('dest');
+ return $error if $error;
+
+ if ( $self->dest eq 'POST' ) {
+ #contemplate our navel
+ } elsif ( $self->dest =~ /^(\d+)$/ ) {
+ return "Unknown local account (specified by svcnum: ". $self->dest. ")"
+ unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } );
+ } elsif ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) {
+ my($user, $domain) = ($1, $2);
+# if ( $domain eq $mydomain ) {
+# my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } );
+# return "Unknown local account: $user\@$domain (specified literally)"
+# unless $svc_acct;
+# $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!";
+# $self->dest($1);
+# }
+ $self->dest("$1\@$2");
+ } else {
+ return gettext("illegal_email_invoice_address");
+ }
+
+ ''; #no error
+}
+
+=item address
+
+Returns the literal email address for this record (or `POST').
+
+=cut
+
+sub address {
+ my $self = shift;
+ if ( $self->dest =~ /^(\d+)$/ ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } )
+ or return undef;
+ $svc_acct->email;
+ } else {
+ $self->dest;
+ }
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_pay;
+
+use strict;
+use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from );
+use Date::Format;
+use Mail::Header;
+use Mail::Internet 1.44;
+use Business::CreditCard;
+use FS::UID qw( dbh );
+use FS::Record qw( dbh qsearch qsearchs dbh );
+use FS::cust_bill;
+use FS::cust_bill_pay;
+use FS::cust_main;
+
+@ISA = qw( FS::Record );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_pay'} = sub {
+
+ $conf = new FS::Conf;
+ $unsuspendauto = $conf->exists('unsuspendauto');
+ $smtpmachine = $conf->config('smtpmachine');
+ $invoice_from = $conf->config('invoice_from');
+
+};
+
+=head1 NAME
+
+FS::cust_pay - Object methods for cust_pay objects
+
+=head1 SYNOPSIS
+
+ use FS::cust_pay;
+
+ $record = new FS::cust_pay \%hash;
+ $record = new FS::cust_pay { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_pay object represents a payment; the transfer of money from a
+customer. FS::cust_pay inherits from FS::Record. The following fields are
+currently supported:
+
+=over 4
+
+=item paynum - primary key (assigned automatically for new payments)
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item paid - Amount of this payment
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
+
+=item payinfo - card number, check #, or comp issuer (4-8 lowercase alphanumerics; think username), respectively
+
+=item paybatch - text field for tracking card processing
+
+=item closed - books closed flag, empty or `Y'
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new payment. To add the payment to the databse, see L<"insert">.
+
+=cut
+
+sub table { 'cust_pay'; }
+
+=item insert
+
+Adds this payment to the database.
+
+For backwards-compatibility and convenience, if the additional field invnum
+is defined, an FS::cust_bill_pay record for the full amount of the payment
+will be created. In this case, custnum is optional.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ if ( $self->invnum ) {
+ my $cust_bill = qsearchs('cust_bill', { 'invnum' => $self->invnum } )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown cust_bill.invnum: ". $self->invnum;
+ };
+ $self->custnum($cust_bill->custnum );
+ }
+
+ my $cust_main = qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+ my $old_balance = $cust_main->balance;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error inserting $self: $error";
+ }
+
+ if ( $self->invnum ) {
+ my $cust_bill_pay = new FS::cust_bill_pay {
+ 'invnum' => $self->invnum,
+ 'paynum' => $self->paynum,
+ 'amount' => $self->paid,
+ '_date' => $self->_date,
+ };
+ $error = $cust_bill_pay->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error inserting $cust_bill_pay: $error";
+ }
+ }
+
+ if ( $self->paybatch =~ /^webui-/ ) {
+ my @cust_pay = qsearch('cust_pay', {
+ 'custnum' => $self->custnum,
+ 'paybatch' => $self->paybatch,
+ } );
+ if ( scalar(@cust_pay) > 1 ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "a payment with webui token ". $self->paybatch. " already exists";
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ #false laziness w/ cust_credit::insert
+ if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
+ my @errors = $cust_main->unsuspend;
+ #return
+ # side-fx with nested transactions? upstack rolls back?
+ warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
+ join(' / ', @errors)
+ if @errors;
+ }
+ #eslaf
+
+ '';
+
+}
+
+sub upgrade_replace { #1.3.x->1.4.x
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ my %new = $self->hash;
+ my $new = FS::cust_pay->new(\%new);
+
+ if ( $self->invnum ) {
+ my $cust_bill_pay = new FS::cust_bill_pay {
+ 'invnum' => $self->invnum,
+ 'paynum' => $self->paynum,
+ 'amount' => $self->paid,
+ '_date' => $self->_date,
+ };
+ $error = $cust_bill_pay->insert;
+ if ( $error =~
+ /total cust_bill_pay.amount and cust_credit_bill.amount .* for invnum .* greater than cust_bill.charged/ ) {
+ #warn $error;
+ my $cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
+ $new->custnum($cust_bill->custnum);
+ } elsif ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ } else {
+ $new->custnum($cust_bill_pay->cust_bill->custnum);
+ }
+ } else {
+ die;
+ }
+
+ $error = $new->SUPER::replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+
+}
+
+=item delete
+
+Deletes this payment and all associated applications (see L<FS::cust_bill_pay>),
+unless the closed flag is set.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ return "Can't delete closed payment" if $self->closed =~ /^Y/i;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_bill_pay ( $self->cust_bill_pay ) {
+ my $error = $cust_bill_pay->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ my $error = $self->SUPER::delete(@_);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( $conf->config('deletepayments') ne '' ) {
+
+ my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum });
+ #false laziness w/FS::cust_bill::send & fs_signup_server
+ $ENV{MAILADDRESS} = $invoice_from; #??? well as good as any
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". $conf->config('deletepayments'),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: FREESIDE NOTIFICATION: Payment deleted",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [
+ "This is an automatic message from your Freeside installation\n",
+ "informing you that the following payment has been deleted:\n",
+ "\n",
+ 'paynum: '. $self->paynum. "\n",
+ 'custnum: '. $self->custnum.
+ " (". $cust_main->last. ", ". $cust_main->first. ")\n",
+ 'paid: $'. sprintf("%.2f", $self->paid). "\n",
+ 'date: '. time2str("%a %b %e %T %Y", $self->_date). "\n",
+ 'payby: '. $self->payby. "\n",
+ 'payinfo: '. $self->payinfo. "\n",
+ 'paybatch: '. $self->paybatch. "\n",
+ ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "(customer # ". $self->custnum.
+ ") can't send payment deletion email to ".
+ $conf->config('deletepayments').
+ " via server $smtpmachine with SMTP: $!";
+ };
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+}
+
+=item replace OLD_RECORD
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub replace {
+ return "Can't (yet?) modify cust_pay records!";
+}
+
+=item check
+
+Checks all fields to make sure this is a valid payment. If there is an error,
+returns the error, otherwise returns false. Called by the insert method.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('paynum')
+ || $self->ut_numbern('custnum')
+ || $self->ut_money('paid')
+ || $self->ut_numbern('_date')
+ || $self->ut_textn('paybatch')
+ || $self->ut_enum('closed', [ '', 'Y' ])
+ ;
+ return $error if $error;
+
+ return "paid must be > 0 " if $self->paid <= 0;
+
+ return "unknown cust_main.custnum: ". $self->custnum
+ unless $self->invnum
+ || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->_date(time) unless $self->_date;
+
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
+
+ #false laziness with cust_refund::check
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+ $self->payinfo($payinfo);
+ if ( $self->payinfo ) {
+ $self->payinfo =~ /^(\d{13,16})$/
+ or return "Illegal (mistyped?) credit card number (payinfo)";
+ $self->payinfo($1);
+ validate($self->payinfo) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
+ } else {
+ $self->payinfo('N/A');
+ }
+
+ } else {
+ $error = $self->ut_textn('payinfo');
+ return $error if $error;
+ }
+
+ ''; #no error
+
+}
+
+=item cust_bill_pay
+
+Returns all applications to invoices (see L<FS::cust_bill_pay>) for this
+payment.
+
+=cut
+
+sub cust_bill_pay {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_bill_pay', { 'paynum' => $self->paynum } )
+ ;
+}
+
+=item unapplied
+
+Returns the amount of this payment that is still unapplied; which is
+paid minus all payment applications (see L<FS::cust_bill_pay>).
+
+=cut
+
+sub unapplied {
+ my $self = shift;
+ my $amount = $self->paid;
+ $amount -= $_->amount foreach ( $self->cust_bill_pay );
+ sprintf("%.2f", $amount );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pay.pm,v 1.20 2002-05-18 09:51:30 ivan Exp $
+
+=head1 BUGS
+
+Delete and replace methods.
+
+=head1 SEE ALSO
+
+L<FS::cust_bill_pay>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_pay_batch;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record;
+use Business::CreditCard;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_pay_batch - Object methods for batch cards
+
+=head1 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;
+
+=head1 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:
+
+=over 4
+
+=item paybatchnum - primary key (automatically assigned)
+
+=item cardnum
+
+=item exp - card expiration
+
+=item amount
+
+=item invnum - invoice
+
+=item custnum - customer
+
+=item payname - name on card
+
+=item first - name
+
+=item last - name
+
+=item address1
+
+=item address2
+
+=item city
+
+=item state
+
+=item zip
+
+=item country
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record to the database, see L<"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 I<hash> method.
+
+=cut
+
+sub table { 'cust_pay_batch'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item 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.
+
+=cut
+
+sub replace {
+ return "Can't (yet?) replace batched transactions!";
+}
+
+=item 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.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('paybatchnum')
+ || $self->ut_numbern('trancode') #depriciated
+ || $self->ut_number('cardnum')
+ || $self->ut_money('amount')
+ || $self->ut_number('invnum')
+ || $self->ut_number('custnum')
+ || $self->ut_text('address1')
+ || $self->ut_textn('address2')
+ || $self->ut_text('city')
+ || $self->ut_textn('state')
+ ;
+
+ return $error if $error;
+
+ $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
+ $self->setfield('last',$1);
+
+ $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
+ $self->first($1);
+
+ my $cardnum = $self->cardnum;
+ $cardnum =~ s/\D//g;
+ $cardnum =~ /^(\d{13,16})$/
+ or return "Illegal credit card number";
+ $cardnum = $1;
+ $self->cardnum($cardnum);
+ validate($cardnum) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($cardnum) eq "Unknown";
+
+ if ( $self->exp eq '' ) {
+ return "Expriation date required"; #unless
+ $self->exp('');
+ } else {
+ if ( $self->exp =~ /^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})$/ ) {
+ $self->exp("$1-$2-$3");
+ } elsif ( $self->exp =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
+ if ( length($2) == 4 ) {
+ $self->exp("$2-$1-01");
+ } elsif ( $2 > 98 ) { #should pry change to check for "this year"
+ $self->exp("19$2-$1-01");
+ } else {
+ $self->exp("20$2-$1-01");
+ }
+ } else {
+ return "Illegal expiration date";
+ }
+ }
+
+ if ( $self->payname eq '' ) {
+ $self->payname( $self->first. " ". $self->getfield('last') );
+ } else {
+ $self->payname =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal billing name";
+ $self->payname($1);
+ }
+
+ #$self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/
+ # or return "Illegal zip: ". $self->zip;
+ #$self->zip($1);
+
+ $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
+ $self->country($1);
+
+ $error = $self->ut_zip('zip', $self->country);
+ return $error if $error;
+
+ #check invnum, custnum, ?
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pay_batch.pm,v 1.6 2002-02-22 23:08:11 ivan Exp $
+
+=head1 BUGS
+
+There should probably be a configuration file with a list of allowed credit
+card types.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, L<FS::Record>
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_pkg;
+
+use strict;
+use vars qw(@ISA);
+use FS::UID qw( getotaker dbh );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_svc;
+use FS::part_pkg;
+use FS::cust_main;
+use FS::type_pkgs;
+use FS::pkg_svc;
+
+# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
+# setup }
+# because they load configuraion by setting FS::UID::callback (see TODO)
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::svc_www;
+use FS::svc_forward;
+
+@ISA = qw( FS::Record );
+
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ #if ( $hashref->{'pkgpart'} ) {
+ if ( $hashref->{'pkg'} ) {
+ # #@{ $self->{'_pkgnum'} } = ();
+ # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
+ # $self->{'_pkgpart'} = $subcache;
+ # #push @{ $self->{'_pkgnum'} },
+ # FS::part_pkg->new_or_cached($hashref, $subcache);
+ $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
+ }
+ if ( exists $hashref->{'svcnum'} ) {
+ #@{ $self->{'_pkgnum'} } = ();
+ my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
+ $self->{'_svcnum'} = $subcache;
+ #push @{ $self->{'_pkgnum'} },
+ FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
+ }
+}
+
+=head1 NAME
+
+FS::cust_pkg - Object methods for cust_pkg objects
+
+=head1 SYNOPSIS
+
+ use FS::cust_pkg;
+
+ $record = new FS::cust_pkg \%hash;
+ $record = new FS::cust_pkg { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->cancel;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $part_pkg = $record->part_pkg;
+
+ @labels = $record->labels;
+
+ $seconds = $record->seconds_since($timestamp);
+
+ $error = FS::cust_pkg::order( $custnum, \@pkgparts );
+ $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
+
+=head1 DESCRIPTION
+
+An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item pkgnum - primary key (assigned automatically for new billing items)
+
+=item custnum - Customer (see L<FS::cust_main>)
+
+=item pkgpart - Billing item definition (see L<FS::part_pkg>)
+
+=item setup - date
+
+=item bill - date
+
+=item susp - date
+
+=item expire - date
+
+=item cancel - date
+
+=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
+
+=item manual_flag - If this field is set to 1, disables the automatic
+unsuspension of this package when using the B<unsuspendauto> config file.
+
+=back
+
+Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
+see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
+conversion functions.
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Create a new billing item. To add the item to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_pkg'; }
+
+=item insert
+
+Adds this billing item to the database ("Orders" the item). If there is an
+error, returns the error, otherwise returns false.
+
+=cut
+
+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
+ # (is this still necessary with transactions?)
+
+ my $error = $self->ut_number('custnum');
+ return $error if $error;
+
+ my $cust_main = $self->cust_main;
+ return "Unknown customer ". $self->custnum unless $cust_main;
+
+ my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
+ my $pkgpart_href = $agent->pkgpart_hashref;
+ return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart
+ unless $pkgpart_href->{ $self->pkgpart };
+
+ $self->SUPER::insert;
+
+}
+
+=item delete
+
+This method now works but you probably shouldn't use it.
+
+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.
+
+=cut
+
+#sub delete {
+# return "Can't delete cust_pkg records!";
+#}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
+
+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 L<FS::cust_main>).
+
+suspend is normally updated by the suspend and unsuspend methods.
+
+cancel is normally updated by the cancel method (and also the order subroutine
+in some cases).
+
+=cut
+
+sub replace {
+ my( $new, $old ) = ( shift, shift );
+
+ #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
+ return "Can't change otaker!" if $old->otaker ne $new->otaker;
+
+ #allow this *sigh*
+ #return "Can't change setup once it exists!"
+ # if $old->getfield('setup') &&
+ # $old->getfield('setup') != $new->getfield('setup');
+
+ #some logic for bill, susp, cancel?
+
+ $new->SUPER::replace($old);
+}
+
+=item check
+
+Checks all fields to make sure this is a valid billing item. If there is an
+error, returns the error, otherwise returns false. Called by the insert and
+replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('pkgnum')
+ || $self->ut_numbern('custnum')
+ || $self->ut_number('pkgpart')
+ || $self->ut_numbern('setup')
+ || $self->ut_numbern('bill')
+ || $self->ut_numbern('susp')
+ || $self->ut_numbern('cancel')
+ ;
+ return $error if $error;
+
+ if ( $self->custnum ) {
+ return "Unknown customer ". $self->custnum unless $self->cust_main;
+ }
+
+ return "Unknown pkgpart: ". $self->pkgpart
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+
+ $self->otaker(getotaker) unless $self->otaker;
+ $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
+ $self->otaker($1);
+
+ if ( $self->dbdef_table->column('manual_flag') ) {
+ $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+ $self->manual_flag($1);
+ }
+
+ ''; #no error
+}
+
+=item cancel
+
+Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
+in this package, then cancels the package itself (sets the cancel field to
+now).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub cancel {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
+ ) {
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
+ my $svcdb = $1;
+ require "FS/$svcdb.pm";
+
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
+ if ($svc) {
+ $error = $svc->cancel;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling service: $error"
+ }
+ $error = $svc->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error deleting service: $error";
+ }
+ }
+
+ $error = $cust_svc->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error deleting cust_svc: $error";
+ }
+
+ }
+
+ unless ( $self->getfield('cancel') ) {
+ my %hash = $self->hash;
+ $hash{'cancel'} = time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+}
+
+=item suspend
+
+Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
+package, then suspends the package itself (sets the susp field to now).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub suspend {
+ my $self = shift;
+ my $error ;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
+ ) {
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
+ my $svcdb = $1;
+ require "FS/$svcdb.pm";
+
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
+ if ($svc) {
+ $error = $svc->suspend;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ unless ( $self->getfield('susp') ) {
+ my %hash = $self->hash;
+ $hash{'susp'} = time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+}
+
+=item unsuspend
+
+Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
+package, then unsuspends the package itself (clears the susp field).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unsuspend {
+ my $self = shift;
+ my($error);
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_svc (
+ qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
+ ) {
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
+ my $svcdb = $1;
+ require "FS/$svcdb.pm";
+
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
+ if ($svc) {
+ $error = $svc->unsuspend;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ unless ( ! $self->getfield('susp') ) {
+ my %hash = $self->hash;
+ $hash{'susp'} = '';
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+}
+
+=item part_pkg
+
+Returns the definition for this billing item, as an FS::part_pkg object (see
+L<FS::part_pkg>).
+
+=cut
+
+sub part_pkg {
+ my $self = shift;
+ #exists( $self->{'_pkgpart'} )
+ $self->{'_pkgpart'}
+ ? $self->{'_pkgpart'}
+ : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item cust_svc
+
+Returns the services for this package, as FS::cust_svc objects (see
+L<FS::cust_svc>)
+
+=cut
+
+sub cust_svc {
+ my $self = shift;
+ if ( $self->{'_svcnum'} ) {
+ values %{ $self->{'_svcnum'}->cache };
+ } else {
+ qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+ }
+}
+
+=item labels
+
+Returns a list of lists, calling the label method for all services
+(see L<FS::cust_svc>) of this billing item.
+
+=cut
+
+sub labels {
+ my $self = shift;
+ map { [ $_->label ] } $self->cust_svc;
+}
+
+=item cust_main
+
+Returns the parent customer object (see L<FS::cust_main>).
+
+=cut
+
+sub cust_main {
+ my $self = shift;
+ qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+}
+
+=item seconds_since TIMESTAMP
+
+Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online since TIMESTAMP.
+
+TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub seconds_since {
+ my($self, $since) = @_;
+ my $seconds = 0;
+
+ foreach my $cust_svc (
+ grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
+ ) {
+ $seconds += $cust_svc->seconds_since($since);
+ }
+
+ $seconds;
+
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
+
+CUSTNUM is a customer (see L<FS::cust_main>)
+
+PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
+L<FS::part_pkg>) to order for this customer. Duplicates are of course
+permitted.
+
+REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
+remove for this customer. The services (see L<FS::cust_svc>) are moved to the
+new billing items. An error is returned if this is not possible (see
+L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
+parameter.
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.
+
+=cut
+
+sub order {
+ my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
+ $remove_pkgnums = [] unless defined($remove_pkgnums);
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ # 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 %part_pkg = %{ $agent->pkgpart_hashref };
+
+ my(%svcnum);
+ # generate %svcnum
+ # for those packages being removed:
+ #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
+ my($pkgnum);
+ foreach $pkgnum ( @{$remove_pkgnums} ) {
+ foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
+ push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
+ }
+ }
+
+ my @cust_svc;
+ #generate @cust_svc
+ # for those packages the customer is purchasing:
+ # @{$pkgparts} is a list of said packages, by pkgpart
+ # @cust_svc is a corresponding list of lists of FS::Record objects
+ foreach my $pkgpart ( @{$pkgparts} ) {
+ unless ( $part_pkg{$pkgpart} ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Customer not permitted to purchase pkgpart $pkgpart!";
+ }
+ push @cust_svc, [
+ map {
+ ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
+ } map { $_->svcpart }
+ qsearch('pkg_svc', { pkgpart => $pkgpart,
+ quantity => { op=>'>', value=>'0', } } )
+ ];
+ }
+
+ #special-case until this can be handled better
+ # move services to new svcparts - even if the svcparts don't match (svcdb
+ # needs to...)
+ # looks like they're moved in no particular order, ewwwwwwww
+ # and looks like just one of each svcpart can be moved... o well
+
+ #start with still-leftover services
+ #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ next unless @{ $svcnum{$svcpart} };
+
+ my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
+
+ #find an empty place to put one
+ my $i = 0;
+ foreach my $pkgpart ( @{$pkgparts} ) {
+ my @pkg_svc =
+ qsearch('pkg_svc', { pkgpart => $pkgpart,
+ quantity => { op=>'>', value=>'0', } } );
+ #my @pkg_svc =
+ # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
+ if ( ! @{$cust_svc[$i]} #find an empty place to put them with
+ && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
+ @pkg_svc
+ ) {
+ my $new_svcpart =
+ ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
+ my $cust_svc = shift @{$svcnum{$svcpart}};
+ $cust_svc->svcpart($new_svcpart);
+ #warn "changing from $svcpart to $new_svcpart!!!\n";
+ $cust_svc[$i] = [ $cust_svc ];
+ }
+ $i++;
+ }
+
+ }
+
+ #check for leftover services
+ foreach (keys %svcnum) {
+ next unless @{ $svcnum{$_} };
+ $dbh->rollback if $oldAutoCommit;
+ return "Leftover services, svcpart $_: svcnum ".
+ join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
+ }
+
+ #no leftover services, let's make changes.
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ #first cancel old packages
+ foreach my $pkgnum ( @{$remove_pkgnums} ) {
+ my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ unless ( $old ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Package $pkgnum not found to remove!";
+ }
+ my(%hash) = $old->hash;
+ $hash{'cancel'}=time;
+ my($new) = new FS::cust_pkg ( \%hash );
+ my($error)=$new->replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't update package $pkgnum: $error";
+ }
+ }
+
+ #now add new packages, changing cust_svc records if necessary
+ my $pkgpart;
+ while ($pkgpart=shift @{$pkgparts} ) {
+
+ my $new = new FS::cust_pkg {
+ 'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ };
+ my $error = $new->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't insert new cust_pkg record: $error";
+ }
+ push @{$return_cust_pkg}, $new if $return_cust_pkg;
+ my $pkgnum = $new->pkgnum;
+
+ foreach my $cust_svc ( @{ shift @cust_svc } ) {
+ my(%hash) = $cust_svc->hash;
+ $hash{'pkgnum'}=$pkgnum;
+ my $new = new FS::cust_svc ( \%hash );
+
+ #avoid Record diffing missing changed svcpart field from above.
+ my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
+
+ my $error = $new->replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Couldn't link old service to new package: $error";
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pkg.pm,v 1.21 2002-05-04 00:47:24 ivan Exp $
+
+=head1 BUGS
+
+sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
+
+In sub order, the @pkgparts array (passed by reference) is clobbered.
+
+Also in sub order, no money is adjusted. Once FS::part_pkg 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.
+
+Now that things are transactional should the check in the insert method be
+moved to check ?
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
+L<FS::pkg_svc>, schema.html from the base documentation
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_refund;
+
+use strict;
+use vars qw( @ISA );
+use Business::CreditCard;
+use FS::Record qw( qsearchs dbh );
+use FS::UID qw(getotaker);
+use FS::cust_credit;
+use FS::cust_credit_refund;
+use FS::cust_main;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::cust_refund - Object method for cust_refund objects
+
+=head1 SYNOPSIS
+
+ use FS::cust_refund;
+
+ $record = new FS::cust_refund \%hash;
+ $record = new FS::cust_refund { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_refund represents a refund: the transfer of money to a customer;
+equivalent to a negative payment (see L<FS::cust_pay>). FS::cust_refund
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item refundnum - primary key (assigned automatically for new refunds)
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item refund - Amount of the refund
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
+
+=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
+
+=item paybatch - text field for tracking card processing
+
+=item otaker - order taker (assigned automatically, see L<FS::UID>)
+
+=item closed - books closed flag, empty or `Y'
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new refund. To add the refund to the database, see L<"insert">.
+
+=cut
+
+sub table { 'cust_refund'; }
+
+=item insert
+
+Adds this refund to the database.
+
+For backwards-compatibility and convenience, if the additional field crednum is
+defined, an FS::cust_credit_refund record for the full amount of the refund
+will be created. In this case, custnum is optional.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ if ( $self->crednum ) {
+ my $cust_credit = qsearchs('cust_credit', { 'crednum' => $self->crednum } )
+ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown cust_credit.crednum: ". $self->crednum;
+ };
+ $self->custnum($cust_credit->custnum);
+ }
+
+ my $error = $self->check;
+ return $error if $error;
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( $self->crednum ) {
+ my $cust_credit_refund = new FS::cust_credit_refund {
+ 'crednum' => $self->crednum,
+ 'refundnum' => $self->refundnum,
+ 'amount' => $self->refund,
+ '_date' => $self->_date,
+ };
+ $error = $cust_credit_refund->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ #$self->custnum($cust_credit_refund->cust_credit->custnum);
+ }
+
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+}
+
+sub upgrade_replace { #1.3.x->1.4.x
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ my %new = $self->hash;
+ my $new = FS::cust_refund->new(\%new);
+
+ if ( $self->crednum ) {
+ my $cust_credit_refund = new FS::cust_credit_refund {
+ 'crednum' => $self->crednum,
+ 'refundnum' => $self->refundnum,
+ 'amount' => $self->refund,
+ '_date' => $self->_date,
+ };
+ $error = $cust_credit_refund->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $new->custnum($cust_credit_refund->cust_credit->custnum);
+ } else {
+ die;
+ }
+
+ $error = $new->SUPER::replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+}
+
+=item delete
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub delete {
+ my $self = shift;
+ return "Can't delete closed refund" if $self->closed =~ /^Y/i;
+ $self->SUPER::delete(@_);
+}
+
+=item replace OLD_RECORD
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub replace {
+ return "Can't (yet?) modify cust_refund records!";
+}
+
+=item check
+
+Checks all fields to make sure this is a valid refund. If there is an error,
+returns the error, otherwise returns false. Called by the insert method.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('refundnum')
+ || $self->ut_numbern('custnum')
+ || $self->ut_money('refund')
+ || $self->ut_numbern('_date')
+ || $self->ut_textn('paybatch')
+ || $self->ut_enum('closed', [ '', 'Y' ])
+ ;
+ return $error if $error;
+
+ return "refund must be > 0 " if $self->refund <= 0;
+
+ $self->_date(time) unless $self->_date;
+
+ return "unknown cust_main.custnum: ". $self->custnum
+ unless $self->crednum
+ || qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
+
+ #false laziness with cust_pay::check
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $payinfo =~ s/\D//g;
+ $self->payinfo($payinfo);
+ if ( $self->payinfo ) {
+ $self->payinfo =~ /^(\d{13,16})$/
+ or return "Illegal (mistyped?) credit card number (payinfo)";
+ $self->payinfo($1);
+ validate($self->payinfo) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
+ } else {
+ $self->payinfo('N/A');
+ }
+
+ } else {
+ $error = $self->ut_textn('payinfo');
+ return $error if $error;
+ }
+
+ $self->otaker(getotaker);
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_refund.pm,v 1.18 2002-02-19 03:22:39 jeff Exp $
+
+=head1 BUGS
+
+Delete and replace methods.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_credit>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_svc;
+
+use strict;
+use vars qw( @ISA );
+use Carp qw( cluck );
+use FS::Record qw( qsearch qsearchs dbh );
+use FS::cust_pkg;
+use FS::part_pkg;
+use FS::part_svc;
+use FS::pkg_svc;
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::svc_forward;
+use FS::domain_record;
+
+@ISA = qw( FS::Record );
+
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ if ( $hashref->{'username'} ) {
+ $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
+ }
+ if ( $hashref->{'svc'} ) {
+ $self->{'_svcpart'} = FS::part_svc->new($hashref);
+ }
+}
+
+=head1 NAME
+
+FS::cust_svc - Object method for cust_svc objects
+
+=head1 SYNOPSIS
+
+ use FS::cust_svc;
+
+ $record = new FS::cust_svc \%hash
+ $record = new FS::cust_svc { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ ($label, $value) = $record->label;
+
+=head1 DESCRIPTION
+
+An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
+The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key (assigned automatically for new services)
+
+=item pkgnum - Package (see L<FS::cust_pkg>)
+
+=item svcpart - Service definition (see L<FS::part_svc>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new service. To add the refund to the database, see L<"insert">.
+Services are normally created by creating FS::svc_ objects (see
+L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
+
+=cut
+
+sub table { 'cust_svc'; }
+
+=item insert
+
+Adds this service to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this service from the database. If there is an error, returns the
+error, otherwise returns false.
+
+Called by the cancel method of the package (see L<FS::cust_pkg>).
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $new->SUPER::replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error if $error;
+ }
+
+ if ( $new->svcpart != $old->svcpart ) {
+ my $svc_x = $new->svc_x;
+ my $new_svc_x = ref($svc_x)->new({$svc_x->hash});
+ my $error = $new_svc_x->replace($svc_x);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error if $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+
+}
+
+=item check
+
+Checks all fields to make sure this is a valid service. If there is an error,
+returns the error, otehrwise returns false. Called by the insert and
+replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('svcnum')
+ || $self->ut_numbern('pkgnum')
+ || $self->ut_number('svcpart')
+ ;
+ return $error if $error;
+
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+ return "Unknown svcpart" unless $part_svc;
+
+ if ( $self->pkgnum ) {
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+ return "Unknown pkgnum" unless $cust_pkg;
+ my $pkg_svc = qsearchs( 'pkg_svc', {
+ 'pkgpart' => $cust_pkg->pkgpart,
+ 'svcpart' => $self->svcpart,
+ });
+ # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
+ # 'svcpart' => $self->svcpart,
+ # 'quantity' => 0 } );
+
+ my @cust_svc = qsearch('cust_svc', {
+ 'pkgnum' => $self->pkgnum,
+ 'svcpart' => $self->svcpart,
+ });
+ return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
+ " services for pkgnum ". $self->pkgnum
+ if scalar(@cust_svc) >= $pkg_svc->quantity;
+ }
+
+ ''; #no error
+}
+
+=item part_svc
+
+Returns the definition for this service, as a FS::part_svc object (see
+L<FS::part_svc>).
+
+=cut
+
+sub part_svc {
+ my $self = shift;
+ $self->{'_svcpart'}
+ ? $self->{'_svcpart'}
+ : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+}
+
+=item cust_pkg
+
+Returns the definition for this service, as a FS::part_svc object (see
+L<FS::part_svc>).
+
+=cut
+
+sub cust_pkg {
+ my $self = shift;
+ qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+}
+
+=item 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
+
+=cut
+
+sub label {
+ my $self = shift;
+ my $svcdb = $self->part_svc->svcdb;
+ my $svc_x = $self->svc_x
+ or die "can't find $svcdb.svcnum ". $self->svcnum;
+ my $tag;
+ if ( $svcdb eq 'svc_acct' ) {
+ $tag = $svc_x->email;
+ } elsif ( $svcdb eq 'svc_acct_sm' ) {
+ my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
+ my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
+ my $domain = $svc_domain->domain;
+ $tag = "$domuser\@$domain";
+ } elsif ( $svcdb eq 'svc_forward' ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
+ $tag = $svc_acct->email. '->';
+ if ( $svc_x->dstsvc ) {
+ $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
+ $tag .= $svc_acct->email;
+ } else {
+ $tag .= $svc_x->dst;
+ }
+ } elsif ( $svcdb eq 'svc_domain' ) {
+ $tag = $svc_x->getfield('domain');
+ } elsif ( $svcdb eq 'svc_www' ) {
+ my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
+ $tag = $domain->reczone;
+ } else {
+ cluck "warning: asked for label of unsupported svcdb; using svcnum";
+ $tag = $svc_x->getfield('svcnum');
+ }
+ $self->part_svc->svc, $tag, $svcdb;
+}
+
+=item svc_x
+
+Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
+FS::svc_domain object, etc.)
+
+=cut
+
+sub svc_x {
+ my $self = shift;
+ my $svcdb = $self->part_svc->svcdb;
+ if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
+ $self->{'_svc_acct'};
+ } else {
+ qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
+ }
+}
+
+=item seconds_since TIMESTAMP
+
+See L<FS::svc_acct/seconds_since>. Equivalent to
+$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
+where B<svcdb> is not "svc_acct".
+
+=cut
+
+#note: implementation here, POD in FS::svc_acct
+sub seconds_since {
+ my($self, $since) = @_;
+ my $dbh = dbh;
+ my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
+ WHERE svcnum = ?
+ AND login >= ?
+ AND logout IS NOT NULL'
+ ) or die $dbh->errstr;
+ $sth->execute($self->svcnum, $since) or die $sth->errstr;
+ $sth->fetchrow_arrayref->[0];
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_svc.pm,v 1.14 2002-04-20 02:06:38 ivan Exp $
+
+=head1 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 checked in general (here).
+
+Deleting this record doesn't check or delete the svc_* record associated
+with this record.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
+schema.html from the base documentation
+
+=cut
+
+1;
+
--- /dev/null
+package FS::cust_tax_exempt;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::cust_tax_exempt - Object methods for cust_tax_exempt records
+
+=head1 SYNOPSIS
+
+ use FS::cust_tax_exempt;
+
+ $record = new FS::cust_tax_exempt \%hash;
+ $record = new FS::cust_tax_exempt { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_tax_exempt object represents a historical record of a customer tax
+exemption. Currently this is only used for "texas tax". FS::cust_tax_exempt
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item exemptnum - primary key
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item taxnum - tax rate (see L<FS::cust_main_county>)
+
+=item year
+
+=item month
+
+=item amount
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new exemption record. To add the example to the database, see
+L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'cust_tax_exempt'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('exemptnum')
+ || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
+ || $self->ut_foreign_key('taxnum', 'cust_main_county', 'taxnum')
+ || $self->ut_number('year') #check better
+ || $self->ut_number('month') #check better
+ || $self->ut_money('amount')
+ ;
+}
+
+=back
+
+=head1 BUGS
+
+Texas tax is a royal pain in the ass.
+
+=head1 SEE ALSO
+
+L<FS::cust_main_county>, L<FS::cust_main>, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::domain_record;
+
+use strict;
+use vars qw( @ISA );
+#use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearchs );
+use FS::svc_domain;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::domain_record - Object methods for domain_record records
+
+=head1 SYNOPSIS
+
+ use FS::domain_record;
+
+ $record = new FS::domain_record \%hash;
+ $record = new FS::domain_record { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::domain_record object represents an entry in a DNS zone.
+FS::domain_record inherits from FS::Record. The following fields are currently
+supported:
+
+=over 4
+
+=item recnum - primary key
+
+=item svcnum - Domain (see L<FS::svc_domain>) of this entry
+
+=item reczone - partial (or full) zone for this entry
+
+=item recaf - address family for this entry, currently only `IN' is recognized.
+
+=item rectype - record type for this entry (A, MX, etc.)
+
+=item recdata - data for this entry
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new entry. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+sub table { 'domain_record'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('recnum')
+ || $self->ut_number('svcnum')
+ ;
+ return $error if $error;
+
+ return "Unknown svcnum (in svc_domain)"
+ unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
+
+ $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
+ or return "Illegal reczone: ". $self->reczone;
+ $self->reczone($1);
+
+ $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
+ $self->recaf($1);
+
+ $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/
+ or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
+ $self->rectype;
+ $self->rectype($1);
+
+ return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
+ if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
+
+ if ( $self->rectype eq 'SOA' ) {
+ my $recdata = $self->recdata;
+ $recdata =~ s/\s+/ /g;
+ $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i
+ or return "Illegal data for SOA record: $recdata";
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'NS' ) {
+ $self->recdata =~ /^([a-z0-9\.\-]+)$/i
+ or return "Illegal data for NS record: ". $self->recdata;
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'MX' ) {
+ $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
+ or return "Illegal data for MX record: ". $self->recdata;
+ $self->recdata("$1 $2");
+ } elsif ( $self->rectype eq 'A' ) {
+ $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
+ or return "Illegal data for A record: ". $self->recdata;
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'PTR' ) {
+ $self->recdata =~ /^([a-z0-9\.\-]+)$/i
+ or return "Illegal data for PTR record: ". $self->recdata;
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'CNAME' ) {
+ $self->recdata =~ /^([a-z0-9\.\-]+)$/i
+ or return "Illegal data for CNAME record: ". $self->recdata;
+ $self->recdata($1);
+ } elsif ( $self->rectype eq '_mstr' ) {
+ $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
+ or return "Illegal data for _master pseudo-record: ". $self->recdata;
+ } else {
+ die "ack!";
+ }
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: domain_record.pm,v 1.7 2002-04-20 11:57:35 ivan Exp $
+
+=head1 BUGS
+
+The data validation doesn't check everything it could. In particular,
+there is no protection against bad data that passes the regex, duplicate
+SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of
+course, it's still better than editing the zone files directly. :)
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::export_svc;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_export;
+use FS::part_svc;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::export_svc - Object methods for export_svc records
+
+=head1 SYNOPSIS
+
+ use FS::export_svc;
+
+ $record = new FS::export_svc \%hash;
+ $record = new FS::export_svc { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::export_svc object links a service definition (see L<FS::part_svc>) to
+an export (see L<FS::part_export>). FS::export_svc inherits from FS::Record.
+The following fields are currently supported:
+
+=over 4
+
+=item exportsvcnum - primary key
+
+=item exportnum - export (see L<FS::part_export>)
+
+=item svcpart - service definition (see L<FS::part_svc>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'export_svc'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('exportsvcnum')
+ || $self->ut_number('exportnum')
+ || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
+ || $self->ut_number('svcpart')
+ || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
+ ;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::part_export>, L<FS::part_svc>, L<FS::Record>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::msgcat;
+
+use strict;
+use vars qw( @ISA );
+use Exporter;
+use FS::UID;
+use FS::Record qw( qsearchs );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::msgcat - Object methods for message catalog entries
+
+=head1 SYNOPSIS
+
+ use FS::msgcat;
+
+ $record = new FS::msgcat \%hash;
+ $record = new FS::msgcat { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::msgcat object represents an message catalog entry. FS::msgcat inherits
+from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item msgnum - primary key
+
+=item msgcode - Error code
+
+=item locale - Locale
+
+=item msg - Message
+
+=back
+
+If you just want to B<use> message catalogs, see L<FS::Msgcat>.
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'msgcat'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('msgnum')
+ || $self->ut_text('msgcode')
+ || $self->ut_text('msg')
+ ;
+ return $error if $error;
+
+ $self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale;
+ $self->locale($1);
+
+ ''; #no error
+}
+
+=back
+
+=head1 BUGS
+
+i18n/l10n, eek
+
+=head1 SEE ALSO
+
+L<FS::Msgcat>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::nas;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw(qsearchs); #qsearch);
+use FS::UID qw( dbh );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::nas - Object methods for nas records
+
+=head1 SYNOPSIS
+
+ use FS::nas;
+
+ $record = new FS::nas \%hash;
+ $record = new FS::nas {
+ 'nasnum' => 1,
+ 'nasip' => '10.4.20.23',
+ 'nasfqdn' => 'box1.brc.nv.us.example.net',
+ };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->heartbeat($timestamp);
+
+=head1 DESCRIPTION
+
+An FS::nas object represents an Network Access Server on your network, such as
+a terminal server or equivalent. FS::nas inherits from FS::Record. The
+following fields are currently supported:
+
+=over 4
+
+=item nasnum - primary key
+
+=item nas - NAS name
+
+=item nasip - NAS ip address
+
+=item nasfqdn - NAS fully-qualified domain name
+
+=item last - timestamp indicating the last instant the NAS was in a known
+ state (used by the session monitoring).
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new NAS. To add the NAS to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'nas'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('nasnum')
+ || $self->ut_text('nas')
+ || $self->ut_ip('nasip')
+ || $self->ut_domain('nasfqdn')
+ || $self->ut_numbern('last');
+}
+
+=item heartbeat TIMESTAMP
+
+Updates the timestamp for this nas
+
+=cut
+
+sub heartbeat {
+ my($self, $timestamp) = @_;
+ my $dbh = dbh;
+ my $sth =
+ $dbh->prepare("UPDATE nas SET last = ? WHERE nasnum = ? AND last < ?");
+ $sth->execute($timestamp, $self->nasnum, $timestamp) or die $sth->errstr;
+ $self->last($timestamp);
+}
+
+=back
+
+=head1 VERSION
+
+$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $
+
+=head1 BUGS
+
+heartbeat method uses SQL directly and doesn't update history tables.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_bill_event;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::Conf;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::part_bill_event - Object methods for part_bill_event records
+
+=head1 SYNOPSIS
+
+ use FS::part_bill_event;
+
+ $record = new FS::part_bill_event \%hash;
+ $record = new FS::part_bill_event { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_bill_event object represents an invoice event definition -
+a callback which is triggered when an invoice is a certain amount of time
+overdue. FS::part_bill_event inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item eventpart - primary key
+
+=item payby - CARD, BILL, or COMP
+
+=item event - event name
+
+=item eventcode - event action
+
+=item seconds - how long after the invoice date events of this type are triggered
+
+=item weight - ordering for events with identical seconds
+
+=item plan - eventcode plan
+
+=item plandata - additional plan data
+
+=item disabled - Disabled flag, empty or `Y'
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new invoice event definition. To add the example to the database,
+see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'part_bill_event'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid invoice event definition. If
+there is an error, returns the error, otherwise returns false. Called by the
+insert and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ $self->weight(0) unless $self->weight;
+
+ my $conf = new FS::Conf;
+ if ( $conf->exists('safe-part_bill_event') ) {
+ my $error = $self->ut_anything('eventcode');
+ return $error if $error;
+
+ my $c = $self->eventcode;
+
+ $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/
+
+ or $c =~ /^\s*\$cust_bill\->(comp|realtime_card|realtime_card_cybercash|batch_card|send)\(\);\s*$/
+
+ or $c =~ /^\s*\$cust_bill\->send\(\'\w+\'\);\s*$/
+
+ or $c =~ /^\s*\$cust_main\->apply_payments; \$cust_main->apply_credits; "";\s*$/
+
+ or $c =~ /^\s*\$cust_main\->charge\( \s*\d*\.?\d*\s*,\s*\'[\w \!\@\#\$\%\&\(\)\-\+\;\:\"\,\.\?\/]*\'\s*\);\s*$/
+
+ or do {
+ #log
+ return "illegal eventcode: $c";
+ };
+
+ }
+
+ my $error = $self->ut_numbern('eventpart')
+ || $self->ut_enum('payby', [qw( CARD BILL COMP )] )
+ || $self->ut_text('event')
+ || $self->ut_anything('eventcode')
+ || $self->ut_number('seconds')
+ || $self->ut_enum('disabled', [ '', 'Y' ] )
+ || $self->ut_number('weight')
+ || $self->ut_textn('plan')
+ || $self->ut_anything('plandata')
+ ;
+ return $error if $error;
+
+ #quelle kludge
+ if ( $self->plandata =~ /^templatename\s+(.*)$/ ) {
+ my $name= $1;
+ unless ( $conf->exists("invoice_template_$name") ) {
+ $conf->set(
+ "invoice_template_$name" =>
+ join("\n", $conf->config('invoice_template') )
+ );
+ }
+ }
+
+ '';
+
+}
+
+=back
+
+=head1 BUGS
+
+Alas.
+
+=head1 SEE ALSO
+
+L<FS::cust_bill>, L<FS::cust_bill_event>, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_export;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK %exports );
+use Exporter;
+use Tie::IxHash;
+use FS::Record qw( qsearch qsearchs dbh );
+use FS::part_svc;
+use FS::part_export_option;
+use FS::export_svc;
+
+@ISA = qw(FS::Record);
+@EXPORT_OK = qw(export_info);
+
+=head1 NAME
+
+FS::part_export - Object methods for part_export records
+
+=head1 SYNOPSIS
+
+ use FS::part_export;
+
+ $record = new FS::part_export \%hash;
+ $record = new FS::part_export { 'column' => 'value' };
+
+ #($new_record, $options) = $template_recored->clone( $svcpart );
+
+ $error = $record->insert( { 'option' => 'value' } );
+ $error = $record->insert( \%options );
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_export object represents an export of Freeside data to an external
+provisioning system. FS::part_export inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item exportnum - primary key
+
+=item machine - Machine name
+
+=item exporttype - Export type
+
+=item nodomain - blank or "Y" : usernames are exported to this service with no domain
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new export. To add the export to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'part_export'; }
+
+=cut
+
+#=item clone SVCPART
+#
+#An alternate constructor. Creates a new export by duplicating an existing
+#export. The given svcpart is assigned to the new export.
+#
+#Returns a list consisting of the new export object and a hashref of options.
+#
+#=cut
+#
+#sub clone {
+# my $self = shift;
+# my $class = ref($self);
+# my %hash = $self->hash;
+# $hash{'exportnum'} = '';
+# $hash{'svcpart'} = shift;
+# ( $class->new( \%hash ),
+# { map { $_->optionname => $_->optionvalue }
+# qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
+# }
+# );
+#}
+
+=item insert HASHREF
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+If a hash reference of options is supplied, part_export_option records are
+created (see L<FS::part_export_option>).
+
+=cut
+
+#false laziness w/queue.pm
+sub insert {
+ my $self = shift;
+ my $options = shift;
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $optionname ( keys %{$options} ) {
+ my $part_export_option = new FS::part_export_option ( {
+ 'exportnum' => $self->exportnum,
+ 'optionname' => $optionname,
+ 'optionvalue' => $options->{$optionname},
+ } );
+ $error = $part_export_option->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+};
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+#foreign keys would make this much less tedious... grr dumb mysql
+sub delete {
+ my $self = shift;
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $part_export_option ( $self->part_export_option ) {
+ my $error = $part_export_option->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ foreach my $export_svc ( $self->export_svc ) {
+ my $error = $export_svc->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+}
+
+=item replace OLD_RECORD HASHREF
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+If a hash reference of options is supplied, part_export_option records are
+created or modified (see L<FS::part_export_option>).
+
+=cut
+
+sub replace {
+ my $self = shift;
+ my $old = shift;
+ my $options = shift;
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $optionname ( keys %{$options} ) {
+ my $old = qsearchs( 'part_export_option', {
+ 'exportnum' => $self->exportnum,
+ 'optionname' => $optionname,
+ } );
+ my $new = new FS::part_export_option ( {
+ 'exportnum' => $self->exportnum,
+ 'optionname' => $optionname,
+ 'optionvalue' => $options->{$optionname},
+ } );
+ $new->optionnum($old->optionnum) if $old;
+ my $error = $old ? $new->replace($old) : $new->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ #remove extraneous old options
+ foreach my $opt (
+ grep { !exists $options->{$_->optionname} } $old->part_export_option
+ ) {
+ my $error = $opt->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+};
+
+=item check
+
+Checks all fields to make sure this is a valid export. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+ my $error =
+ $self->ut_numbern('exportnum')
+ || $self->ut_domain('machine')
+ || $self->ut_alpha('exporttype')
+ ;
+ return $error if $error;
+
+ warn $self->machine. "!!!\n";
+
+ $self->machine =~ /^([\w\-\.]*)$/
+ or return "Illegal machine: ". $self->machine;
+ $self->machine($1);
+
+ $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
+ $self->nodomain($1);
+
+ $self->deprecated(1); #BLAH
+
+ #check exporttype?
+
+ ''; #no error
+}
+
+#=item part_svc
+#
+#Returns the service definition (see L<FS::part_svc>) for this export.
+#
+#=cut
+#
+#sub part_svc {
+# my $self = shift;
+# qsearchs('part_svc', { svcpart => $self->svcpart } );
+#}
+
+sub part_svc {
+ use Carp;
+ croak "FS::part_export::part_svc deprecated";
+ #confess "FS::part_export::part_svc deprecated";
+}
+
+=item export_svc
+
+Returns a list of associated FS::export_svc records.
+
+=cut
+
+sub export_svc {
+ my $self = shift;
+ qsearch('export_svc', { 'exportnum' => $self->exportnum } );
+}
+
+=item part_export_option
+
+Returns all options as FS::part_export_option objects (see
+L<FS::part_export_option>).
+
+=cut
+
+sub part_export_option {
+ my $self = shift;
+ qsearch('part_export_option', { 'exportnum' => $self->exportnum } );
+}
+
+=item options
+
+Returns a list of option names and values suitable for assigning to a hash.
+
+=cut
+
+sub options {
+ my $self = shift;
+ map { $_->optionname => $_->optionvalue } $self->part_export_option;
+}
+
+=item option OPTIONNAME
+
+Returns the option value for the given name, or the empty string.
+
+=cut
+
+sub option {
+ my $self = shift;
+ my $part_export_option =
+ qsearchs('part_export_option', {
+ exportnum => $self->exportnum,
+ optionname => shift,
+ } );
+ $part_export_option ? $part_export_option->optionvalue : '';
+}
+
+=item rebless
+
+Reblesses the object into the FS::part_export::EXPORTTYPE class, where
+EXPORTTYPE is the object's I<exporttype> field. There should be better docs
+on how to create new exports (and they should live in their own files and be
+autoloaded-on-demand), but until then, see L</NEW EXPORT CLASSES>.
+
+=cut
+
+sub rebless {
+ my $self = shift;
+ my $exporttype = $self->exporttype;
+ my $class = ref($self). "::$exporttype";
+ eval "use $class;";
+ bless($self, $class);
+}
+
+=item export_insert SVC_OBJECT
+
+=cut
+
+sub export_insert {
+ my $self = shift;
+ $self->rebless;
+ $self->_export_insert(@_);
+}
+
+#sub AUTOLOAD {
+# my $self = shift;
+# $self->rebless;
+# my $method = $AUTOLOAD;
+# #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
+# $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
+# $self->$method(@_);
+#}
+
+=item export_replace NEW OLD
+
+=cut
+
+sub export_replace {
+ my $self = shift;
+ $self->rebless;
+ $self->_export_replace(@_);
+}
+
+=item export_delete
+
+=cut
+
+sub export_delete {
+ my $self = shift;
+ $self->rebless;
+ $self->_export_delete(@_);
+}
+
+#fallbacks providing useful error messages intead of infinite loops
+sub _export_insert {
+ my $self = shift;
+ return "_export_insert: unknown export type ". $self->exporttype;
+}
+
+sub _export_replace {
+ my $self = shift;
+ return "_export_replace: unknown export type ". $self->exporttype;
+}
+
+sub _export_delete {
+ my $self = shift;
+ return "_export_delete: unknown export type ". $self->exporttype;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item export_info [ SVCDB ]
+
+Returns a hash reference of the exports for the given I<svcdb>, or if no
+I<svcdb> is specified, for all exports. The keys of the hash are
+I<exporttype>s and the values are again hash references containing information
+on the export:
+
+ 'desc' => 'Description',
+ 'options' => {
+ 'option' => { label=>'Option Label' },
+ 'option2' => { label=>'Another label' },
+ },
+ 'nodomain' => 'Y', #or ''
+ 'notes' => 'Additional notes',
+
+=cut
+
+sub export_info {
+ #warn $_[0];
+ return $exports{$_[0]} if @_;
+ #{ map { %{$exports{$_}} } keys %exports };
+ my $r = { map { %{$exports{$_}} } keys %exports };
+}
+
+=item exporttype2svcdb EXPORTTYPE
+
+Returns the applicable I<svcdb> for an I<exporttype>.
+
+=cut
+
+sub exporttype2svcdb {
+ my $exporttype = $_[0];
+ foreach my $svcdb ( keys %exports ) {
+ return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
+ }
+ '';
+}
+
+tie my %shellcommands_options, 'Tie::IxHash',
+ #'machine' => { label=>'Remote machine' },
+ 'user' => { label=>'Remote username', default=>'root' },
+ 'useradd' => { label=>'Insert command',
+ default=>'useradd -d $dir -m -s $shell -u $uid $username'
+ #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'
+ },
+ 'userdel' => { label=>'Delete command',
+ default=>'userdel $username',
+ #default=>'rm -rf $dir',
+ },
+ 'usermod' => { label=>'Modify command',
+ default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username',
+ #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
+ # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
+ # 'find . -depth -print | cpio -pdm $new_dir; '.
+ # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
+ # 'rm -rf $old_dir'.
+ #')'
+ },
+;
+
+tie my %sqlradius_options, 'Tie::IxHash',
+ 'datasrc' => { label=>'DBI data source' },
+ 'username' => { label=>'Database username' },
+ 'password' => { label=>'Database password' },
+;
+
+tie my %cyrus_options, 'Tie::IxHash',
+ 'server' => { label=>'IMAP server' },
+ 'username' => { label=>'Admin username' },
+ 'password' => { label=>'Admin password' },
+;
+
+tie my %cp_options, 'Tie::IxHash',
+ 'host' => { label=>'Hostname' },
+ 'port' => { label=>'Port number' },
+ 'username' => { label=>'Username' },
+ 'password' => { label=>'Password' },
+ 'domain' => { label=>'Domain' },
+ 'workgroup' => { label=>'Default Workgroup' },
+;
+
+tie my %infostreet_options, 'Tie::IxHash',
+ 'url' => { label=>'XML-RPC Access URL', },
+ 'login' => { label=>'InfoStreet login', },
+ 'password' => { label=>'InfoStreet password', },
+ 'groupID' => { label=>'InfoStreet groupID', },
+;
+
+tie my %vpopmail_options, 'Tie::IxHash',
+ 'machine' => { label=>'vpopmail machine', },
+ 'dir' => { label=>'directory', }, # ?more info? default?
+ 'uid' => { label=>'vpopmail uid' },
+ 'gid' => { label=>'vpopmail gid' },
+;
+
+tie my %bind_options, 'Tie::IxHash',
+ #'machine' => { label=>'named machine' },
+ 'named_conf' => { label => 'named.conf location',
+ default=> '/etc/bind/named.conf' },
+ 'zonepath' => { label => 'path to zone files',
+ default=> '/etc/bind/', },
+;
+
+tie my %bind_slave_options, 'Tie::IxHash',
+ #'machine' => { label=> 'Slave machine' },
+ 'master' => { label=> 'Master IP address(s) (semicolon-separated)' },
+ 'named_conf' => { label => 'named.conf location',
+ default => '/etc/bind/named.conf' },
+;
+
+
+
+#export names cannot have dashes...
+%exports = (
+ 'svc_acct' => {
+ 'sysvshell' => {
+ 'desc' =>
+ 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)',
+ 'options' => {},
+ },
+ 'bsdshell' => {
+ 'desc' =>
+ 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)',
+ 'options' => {},
+ },
+# 'nis' => {
+# 'desc' =>
+# 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ',
+# 'options' => {},
+# },
+ 'textradius' => {
+ 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)',
+ 'options' => {},
+ },
+
+ 'shellcommands' => {
+ 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)',
+ 'options' => \%shellcommands_options,
+ 'nodomain' => 'Y',
+ 'notes' => 'shellcommandsnotes... (this one is the nodomain one)',
+ },
+
+ 'sqlradius' => {
+ 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)',
+ 'options' => \%sqlradius_options,
+ 'nodomain' => 'Y',
+ 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. Use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete and repopulate the tables from the Freeside database.',
+ },
+
+ 'cyrus' => {
+ 'desc' => 'Real-time export to Cyrus IMAP server',
+ 'options' => \%cyrus_options,
+ 'nodomain' => 'Y',
+ 'notes' => 'Integration with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. <B>svc_acct.quota</B>, if available, is used to set the Cyrus quota. '
+ },
+
+ 'cp' => {
+ 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol',
+ 'options' => \%cp_options,
+ 'notes' => 'Real-time export to <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. Requires installation of <a href="http://search.cpan.org/search?dist=Net-APP">Net::APP</a> from CPAN.',
+ },
+
+ 'infostreet' => {
+ 'desc' => 'Real-time export to InfoStreet streetSmartAPI',
+ 'options' => \%infostreet_options,
+ 'nodomain' => 'Y',
+ 'notes' => 'Real-time export to <a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. Requires installation of <a href="http://search.cpan.org/search?dist=Frontier-Client">Frontier::Client</a> from CPAN.',
+ },
+
+ 'vpopmail' => {
+ 'desc' => 'Real-time export to vpopmail text files',
+ 'options' => \%vpopmail_options,
+
+ 'notes' => 'Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text files (...extended description from jeff?...)',
+ },
+
+ },
+
+ 'svc_domain' => {
+
+ 'bind' => {
+ 'desc' =>'Batch export to BIND named',
+ 'options' => \%bind_options,
+ 'notes' => 'bind export notes',
+ },
+
+ 'bind_slave' => {
+ 'desc' =>'Batch export to slave BIND named',
+ 'options' => \%bind_slave_options,
+ 'notes' => 'bind export notes (secondary munge)',
+ },
+
+
+ },
+
+ 'svc_acct_sm' => {},
+
+ 'svc_forward' => {},
+
+ 'svc_www' => {},
+
+);
+
+=back
+
+=head1 NEW EXPORT CLASSES
+
+Should be added to the %export hash here, and a module should be added in
+FS/FS/part_export/ (an example may be found in eg/export_template.pm)
+
+=head1 BUGS
+
+Probably.
+
+Hmm... cust_export class (not necessarily a database table...) ... ?
+
+deprecated column...
+
+=head1 SEE ALSO
+
+L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
+L<FS::svc_domain>,
+L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_export::bsdshell;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_acct) = (shift, shift);
+ $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum, 'insert',
+ $svc_acct->username, $svc_acct->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ #return "can't change username with bsdshell"
+ # if $old->username ne $new->username;
+ #return '' unless $old->_password ne $new->_password;
+ $err_or_queue = $self->bsdshell_queue( $new->svcnum,
+ 'replace', $new->username, $new->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum,
+ 'delete', $svc_acct->username );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+#a good idea to queue anything that could fail or take any time
+sub bsdshell_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::bsdshell::bsdshell_$method",
+ };
+ $queue->insert( @_ ) or $queue;
+}
+
+sub bsdshell_insert { #subroutine, not method
+}
+sub bsdshell_replace { #subroutine, not method
+}
+sub bsdshell_delete { #subroutine, not method
+}
+
--- /dev/null
+package FS::part_export::cp;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my( $self, $svc_acct ) = (shift, shift);
+ $self->cp_queue( $svc_acct->svcnum, 'create_mailbox',
+ Mailbox => $svc_acct->username,
+ Password => $svc_acct->_password,
+ Workgroup => $self->option('workgroup'),
+ Domain => $svc_acct->domain,
+ );
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ return "can't change domain with Critical Path"
+ if $old->domain ne $new->domain;
+ return '' unless $old->username ne $new->username
+ || $old->_password ne $new->_password;
+ $self->cp_queue( $new->svcnum, 'replace', $new->domain,
+ $old->username, $new->username, $old->_password, $new->_password );
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox',
+ Mailbox => $svc_acct->username,
+ Domain => $svc_acct->domain,
+ );
+}
+
+sub cp_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => 'FS::part_export::cp::cp_command',
+ };
+ $queue->insert(
+ $self->option('host'),
+ $self->option('port'),
+ $self->option('username'),
+ $self->option('password'),
+ $self->option('domain'),
+ $method,
+ @_,
+ );
+}
+
+sub cp_command { #subroutine, not method
+ my($host, $port, $username, $password, $login_domain, $method, @args) = @_;
+
+ #quelle hack
+ if ( $method eq 'replace' ) {
+
+ my( $domain, $old_username, $new_username, $old_password, $new_password)
+ = @args;
+
+ if ( $old_username ne $new_username ) {
+ cp_command($host, $port, $username, $password, 'rename_mailbox',
+ Domain => $domain,
+ Old_Mailbox => $old_username,
+ New_Mailbox => $new_username,
+ );
+ }
+
+ my $other = 'F';
+ if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) {
+ $new_password = $1;
+ $other = 'T';
+ }
+ cp_command($host, $port, $username, $password, 'set_mailbox_status',
+ Domain => $domain,
+ Mailbox => $new_username,
+ Other => $other,
+ Other_Bounce => $other,
+ );
+
+ if ( $old_password ne $new_password ) {
+ cp_command($host, $port, $username, $password, 'change_mailbox',
+ Domain => $domain,
+ Mailbox => $new_username,
+ Password => $new_password,
+ );
+ }
+
+ return;
+ }
+ #eof quelle hack
+
+ eval "use Net::APP;";
+
+ my $app = new Net::APP (
+ "$host:$port",
+ User => $username,
+ Password => $password,
+ Domain => $login_domain,
+ Timeout => 60,
+ #Debug => 1,
+ ) or die "$@\n";
+
+ $app->$method( @args );
+
+ die $app->message."\n" unless $app->ok;
+
+}
+
--- /dev/null
+package FS::part_export::cyrus;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_acct) = (shift, shift);
+ $self->cyrus_queue( $svc_acct->svcnum, 'insert',
+ $svc_acct->username, $svc_acct->quota );
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ return "can't change username using Cyrus"
+ if $old->username ne $new->username;
+ return '';
+# #return '' unless $old->_password ne $new->_password;
+# $self->cyrus_queue( $new->svcnum,
+# 'replace', $new->username, $new->_password );
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $self->cyrus_queue( $svc_acct->svcnum, 'delete',
+ $svc_acct->username );
+}
+
+#a good idea to queue anything that could fail or take any time
+sub cyrus_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::cyrus::cyrus_$method",
+ };
+ $queue->insert(
+ $self->option('server'),
+ $self->option('username'),
+ $self->option('password'),
+ @_
+ );
+}
+
+sub cyrus_insert { #subroutine, not method
+ my $client = cyrus_connect(shift, shift, shift);
+ my( $username, $quota ) = @_;
+ my $rc = $client->create("user.$username");
+ my $error = $client->error;
+ die "creating user.$username: $error" if $error;
+
+ $rc = $client->setacl("user.$username", $username => 'all' );
+ $error = $client->error;
+ die "setacl user.$username: $error" if $error;
+
+ if ( $quota ) {
+ $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
+ $error = $client->error;
+ die "setquota user.$username: $error" if $error;
+ }
+
+}
+
+sub cyrus_delete { #subroutine, not method
+ my ( $server, $admin_username, $password_username, $username ) = @_;
+ my $client = cyrus_connect($server, $admin_username, $password_username);
+
+ my $rc = $client->setacl("user.$username", $admin_username => 'all' );
+ my $error = $client->error;
+ die $error if $error;
+
+ $rc = $client->delete("user.$username");
+ $error = $client->error;
+ die $error if $error;
+}
+
+sub cyrus_connect {
+
+ my( $server, $admin_username, $admin_password ) = @_;
+
+ eval "use Cyrus::IMAP::Admin;";
+
+ my $client = Cyrus::IMAP::Admin->new($server);
+ $client->authenticate(
+ -user => $admin_username,
+ -mechanism => "login",
+ -password => $admin_password,
+ );
+ $client;
+
+}
+
+#sub cyrus_replace { #subroutine, not method
+#}
+
+
--- /dev/null
+package FS::part_export::infostreet;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my( $self, $svc_acct ) = (shift, shift);
+ $self->infostreet_queue( $svc_acct->svcnum,
+ 'createUser', $svc_acct->username, $svc_acct->_password );
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ return "can't change username with InfoStreet"
+ if $old->username ne $new->username;
+ return '' unless $old->_password ne $new->_password;
+ $self->infostreet_queue( $new->svcnum,
+ 'passwd', $new->username, $new->_password );
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $self->infostreet_queue( $svc_acct->svcnum,
+ 'purgeAccount,releaseUsername', $svc_acct->username );
+}
+
+sub infostreet_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => 'FS::part_export::infostreet::infostreet_command',
+ };
+ $queue->insert(
+ $self->option('url'),
+ $self->option('login'),
+ $self->option('password'),
+ $self->option('groupID'),
+ $method,
+ @_,
+ );
+}
+
+sub infostreet_command { #subroutine, not method
+ my($url, $username, $password, $groupID, $method, @args) = @_;
+
+ #quelle hack
+ if ( $method =~ /,/ ) {
+ foreach my $part ( split(/,\s*/, $method) ) {
+ infostreet_command($url, $username, $password, $groupID, $part, @args);
+ }
+ return;
+ }
+
+ eval "use Frontier::Client;";
+
+ my $conn = Frontier::Client->new( url => $url );
+ my $key_result = $conn->call( 'authenticate', $username, $password, $groupID);
+ my %key_result = _infostreet_parse($key_result);
+ die $key_result{error} unless $key_result{success};
+ my $key = $key_result{data};
+
+ #my $result = $conn->call($method, $key, @args);
+ my $result = $conn->call($method, $key, map { $conn->string($_) } @args);
+ my %result = _infostreet_parse($result);
+ die $result{error} unless $result{success};
+
+}
+
+sub _infostreet_parse { #subroutine, not method
+ my $arg = shift;
+ map {
+ my $value = $arg->{$_};
+ #warn ref($value);
+ $value = $value->value()
+ if ref($value) && $value->isa('Frontier::RPC2::DataType');
+ $_=>$value;
+ } keys %$arg;
+}
+
+
--- /dev/null
+package FS::part_export::shellcommands;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self) = shift;
+ $self->_export_command('useradd', @_);
+}
+
+sub _export_delete {
+ my($self) = shift;
+ $self->_export_command('userdel', @_);
+}
+
+sub _export_command {
+ my ( $self, $action, $svc_acct) = (shift, shift, shift);
+ my $command = $self->option($action);
+ no strict 'refs';
+ ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
+ $self->shellcommands_queue(
+ $self->options('user')||'root'. "\@". $self->options('machine'),
+ eval(qq("$command"))
+ );
+}
+
+sub _export_replace {
+ my($self, $new, $old ) = (shift, shift, shift);
+ my $command = $self->option('usermod');
+ no strict 'refs';
+ ${"old_$_"} = $old->getfield($_) foreach $old->fields;
+ ${"new_$_"} = $new->getfield($_) foreach $new->fields;
+ $self->shellcommands_queue(
+ $self->options('user')||'root'. "\@". $self->options('machine'),
+ eval(qq("$command"))
+ );
+}
+
+#a good idea to queue anything that could fail or take any time
+sub shellcommands_queue {
+ my( $self, $svcnum ) = (shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "Net::SSH::ssh_cmd", #freeside-queued pre-uses...
+ };
+ $queue->insert( @_ );
+}
+
+#sub shellcommands_insert { #subroutine, not method
+#}
+#sub shellcommands_replace { #subroutine, not method
+#}
+#sub shellcommands_delete { #subroutine, not method
+#}
+
--- /dev/null
+package FS::part_export::sqlradius;
+
+use vars qw(@ISA);
+use FS::Record qw( dbh );
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_acct) = (shift, shift);
+
+ foreach my $table (qw(reply check)) {
+ my $method = "radius_$table";
+ my %attrib = $svc_acct->$method;
+ next unless keys %attrib;
+ my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
+ $table, $svc_acct->username, %attrib );
+ return $err_or_queue unless ref($err_or_queue);
+ }
+ my @groups = $svc_acct->radius_groups;
+ if ( @groups ) {
+ my $err_or_queue = $self->sqlradius_queue(
+ $svc_acct->svcnum, 'usergroup_insert',
+ $svc_acct->username, @groups );
+ return $err_or_queue unless ref($err_or_queue);
+ }
+ '';
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $jobnum = '';
+ if ( $old->username ne $new->username ) {
+ my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
+ $new->username, $old->username );
+ unless ( ref($err_or_queue) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $err_or_queue;
+ }
+ $jobnum = $err_or_queue->jobnum;
+ }
+
+ foreach my $table (qw(reply check)) {
+ my $method = "radius_$table";
+ my %new = $new->$method;
+ my %old = $old->$method;
+ if ( grep { !exists $old{$_} #new attributes
+ || $new{$_} ne $old{$_} #changed
+ } keys %new
+ ) {
+ my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
+ $table, $new->username, %new );
+ unless ( ref($err_or_queue) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $err_or_queue;
+ }
+ if ( $jobnum ) {
+ my $error = $err_or_queue->depend_insert( $jobnum );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ my @del = grep { !exists $new{$_} } keys %old;
+ if ( @del ) {
+ my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
+ $table, $new->username, @del );
+ unless ( ref($err_or_queue) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $err_or_queue;
+ }
+ if ( $jobnum ) {
+ my $error = $err_or_queue->depend_insert( $jobnum );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+ }
+
+ # (sorta) false laziness with FS::svc_acct::replace
+ my @oldgroups = @{$old->usergroup}; #uuuh
+ my @newgroups = $new->radius_groups;
+ my @delgroups = ();
+ foreach my $oldgroup ( @oldgroups ) {
+ if ( grep { $oldgroup eq $_ } @newgroups ) {
+ @newgroups = grep { $oldgroup ne $_ } @newgroups;
+ next;
+ }
+ push @delgroups, $oldgroup;
+ }
+
+ if ( @delgroups ) {
+ my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete',
+ $new->username, @delgroups );
+ unless ( ref($err_or_queue) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $err_or_queue;
+ }
+ if ( $jobnum ) {
+ my $error = $err_or_queue->depend_insert( $jobnum );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ if ( @newgroups ) {
+ my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert',
+ $new->username, @newgroups );
+ unless ( ref($err_or_queue) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $err_or_queue;
+ }
+ if ( $jobnum ) {
+ my $error = $err_or_queue->depend_insert( $jobnum );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete',
+ $svc_acct->username );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub sqlradius_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::sqlradius::sqlradius_$method",
+ };
+ $queue->insert(
+ $self->option('datasrc'),
+ $self->option('username'),
+ $self->option('password'),
+ @_,
+ ) or $queue;
+}
+
+sub sqlradius_insert { #subroutine, not method
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my( $table, $username, %attributes ) = @_;
+
+ foreach my $attribute ( keys %attributes ) {
+
+ my $s_sth = $dbh->prepare(
+ "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
+ ) or die $dbh->errstr;
+ $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
+
+ if ( $s_sth->fetchrow_arrayref->[0] ) {
+
+ my $u_sth = $dbh->prepare(
+ "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
+ ) or die $dbh->errstr;
+ $u_sth->execute($attributes{$attribute}, $username, $attribute)
+ or die $u_sth->errstr;
+
+ } else {
+
+ my $i_sth = $dbh->prepare(
+ "INSERT INTO rad$table ( id, UserName, Attribute, Value ) ".
+ "VALUES ( ?, ?, ?, ? )"
+ ) or die $dbh->errstr;
+ $i_sth->execute( '', $username, $attribute, $attributes{$attribute} )
+ or die $i_sth->errstr;
+
+ }
+
+ }
+ $dbh->disconnect;
+}
+
+sub sqlradius_usergroup_insert { #subroutine, not method
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my( $username, @groups ) = @_;
+
+ my $sth = $dbh->prepare(
+ "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )"
+ ) or die $dbh->errstr;
+ foreach my $group ( @groups ) {
+ $sth->execute( '', $username, $group )
+ or die "can't insert into groupname table: ". $sth->errstr;
+ }
+ $dbh->disconnect;
+}
+
+sub sqlradius_usergroup_delete { #subroutine, not method
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my( $username, @groups ) = @_;
+
+ my $sth = $dbh->prepare(
+ "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
+ ) or die $dbh->errstr;
+ foreach my $group ( @groups ) {
+ $sth->execute( $username, $group )
+ or die "can't delete from groupname table: ". $sth->errstr;
+ }
+ $dbh->disconnect;
+}
+
+sub sqlradius_rename { #subroutine, not method
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my($new_username, $old_username) = @_;
+ foreach my $table (qw(radreply radcheck usergroup )) {
+ my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
+ or die $dbh->errstr;
+ $sth->execute($new_username, $old_username)
+ or die "can't update $table: ". $sth->errstr;
+ }
+ $dbh->disconnect;
+}
+
+sub sqlradius_attrib_delete { #subroutine, not method
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my( $table, $username, @attrib ) = @_;
+
+ foreach my $attribute ( @attrib ) {
+ my $sth = $dbh->prepare(
+ "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
+ or die $dbh->errstr;
+ $sth->execute($username,$attribute)
+ or die "can't delete from rad$table table: ". $sth->errstr;
+ }
+ $dbh->disconnect;
+}
+
+sub sqlradius_delete { #subroutine, not method
+ my $dbh = sqlradius_connect(shift, shift, shift);
+ my $username = shift;
+
+ foreach my $table (qw( radcheck radreply usergroup )) {
+ my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
+ $sth->execute($username)
+ or die "can't delete from $table table: ". $sth->errstr;
+ }
+ $dbh->disconnect;
+}
+
+sub sqlradius_connect {
+ #my($datasrc, $username, $password) = @_;
+ #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
+ DBI->connect(@_) or die $DBI::errstr;
+}
+
--- /dev/null
+package FS::part_export::textradius;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_acct) = (shift, shift);
+ $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'insert',
+ $svc_acct->username, $svc_acct->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ #return "can't change username with textradius"
+ # if $old->username ne $new->username;
+ #return '' unless $old->_password ne $new->_password;
+ $err_or_queue = $self->textradius_queue( $new->svcnum,
+ 'replace', $new->username, $new->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $err_or_queue = $self->textradius_queue( $svc_acct->svcnum,
+ 'delete', $svc_acct->username );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+#a good idea to queue anything that could fail or take any time
+sub textradius_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::textradius::textradius_$method",
+ };
+ $queue->insert( @_ ) or $queue;
+}
+
+sub textradius_insert { #subroutine, not method
+}
+sub textradius_replace { #subroutine, not method
+}
+sub textradius_delete { #subroutine, not method
+}
+
--- /dev/null
+package FS::part_export::vpopmail;
+
+use vars qw(@ISA @saltset $exportdir $rsync $ssh);
+use File::Path;
+use FS::UID qw( datasrc );
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+$rsync = "rsync";
+$ssh = "ssh";
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_acct) = (shift, shift);
+ $self->vpopmail_queue( $svc_acct->svcnum, 'insert',
+ $svc_acct->username,
+ crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]),
+ $svc_acct->domain,
+ );
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+
+ my $cpassword = crypt(
+ $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+
+ return "can't change username with vpopmail"
+ if $old->username ne $new->username;
+
+ #no.... if mail can't be preserved, better to disallow username changes
+ #if ($old->username ne $new->username || $old->domain ne $new->domain ) {
+ # vpopmail_queue( $svc_acct->svcnum, 'delete',
+ # $old->username, $old->domain
+ # );
+ # vpopmail_queue( $svc_acct->svcnum, 'insert',
+ # $new->username,
+ # $cpassword,
+ # $new->domain,
+ # );
+
+ return '' unless $old->_password ne $new->_password;
+
+ $self->vpopmail_queue( $new->svcnum, 'replace',
+ $new->username, $cpassword, $new->domain );
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $self->vpopmail_queue( $svc_acct->svcnum, 'delete',
+ $svc_acct->username, $svc_acct->domain );
+}
+
+#a good idea to queue anything that could fail or take any time
+sub vpopmail_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $exportdir = "/usr/local/etc/freeside/export." . datasrc;
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::vpopmail::vpopmail_$method",
+ };
+ $queue->insert(
+ $exportdir,
+ $self->option('machine'),
+ $self->option('dir'),
+ $self->option('uid'),
+ $self->option('gid'),
+ @_
+ );
+}
+
+sub vpopmail_insert { #subroutine, not method
+ my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
+ my( $username, $password, $domain ) = @_;
+
+ (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
+ and flock(VPASSWD,LOCK_EX)
+ ) or die "can't open vpasswd file for $username\@$domain: ".
+ "$exportdir/domains/$domain/vpasswd: $!";
+ print VPASSWD join(":",
+ $username,
+ $password,
+ '1',
+ '0',
+ $username,
+ "$dir/domains/$domain/$username",
+ 'NOQUOTA',
+ ), "\n";
+
+ flock(VPASSWD,LOCK_UN);
+ close(VPASSWD);
+
+ for my $mkdir (
+ map { "$exportdir/domains/$domain/$username$_" }
+ ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) )
+ ) {
+ mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!";
+ }
+
+ vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid );
+
+}
+
+sub vpopmail_replace { #subroutine, not method
+ my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
+ my( $username, $password, $domain ) = @_;
+
+ (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
+ and flock(VPASSWD,LOCK_EX)
+ ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
+
+ open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
+ or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
+
+ while (<VPASSWD>) {
+ my ($mailbox, $pw, @rest) = split(':', $_);
+ print VPASSWDTMP $_ unless $username eq $mailbox;
+ print VPASSWDTMP join (':', ($mailbox, $password, @rest))
+ if $username eq $mailbox;
+ }
+
+ close(VPASSWDTMP);
+
+ rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
+ or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
+
+ flock(VPASSWD,LOCK_UN);
+ close(VPASSWD);
+
+ vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid );
+
+}
+
+sub vpopmail_delete { #subroutine, not method
+ my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
+ my( $username, $domain ) = @_;
+
+ (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
+ and flock(VPASSWD,LOCK_EX)
+ ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
+
+ open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
+ or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
+
+ while (<VPASSWD>) {
+ my ($mailbox, $rest) = split(':', $_);
+ print VPASSWDTMP $_ unless $username eq $mailbox;
+ }
+
+ close(VPASSWDTMP);
+
+ rename "$exportdir/domains/$domain/vpasswd.tmp",
+ "$exportdir/domains/$domain/vpasswd"
+ or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
+
+ flock(VPASSWD,LOCK_UN);
+ close(VPASSWD);
+
+ rmtree "$exportdir/domains/$domain/$username"
+ or die "can't rmtree $exportdir/domains/$domain/$username: $!";
+
+ vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid );
+}
+
+sub vpopmail_sync {
+ my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
+
+ chdir $exportdir;
+ my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/",
+ "vpopmail\@$machine:$dir/domains/" );
+ system {$args[0]} @args;
+}
+
+
--- /dev/null
+package FS::part_export_option;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_export;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::part_export_option - Object methods for part_export_option records
+
+=head1 SYNOPSIS
+
+ use FS::part_export_option;
+
+ $record = new FS::part_export_option \%hash;
+ $record = new FS::part_export_option { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_export_option object represents an export option.
+FS::part_export_option inherits from FS::Record. The following fields are
+currently supported:
+
+=over 4
+
+=item optionnum - primary key
+
+=item exportnum - export (see L<FS::part_export>)
+
+=item optionname - option name
+
+=item optionvalue - option value
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new export option. To add the export option to the database, see
+L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'part_export_option'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid export option. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('optionnum')
+ || $self->ut_number('exportnum')
+ || $self->ut_alpha('optionname')
+ || $self->ut_textn('optionvalue')
+ ;
+ return $error if $error;
+
+ return "Unknown exportnum: ". $self->exportnum
+ unless qsearchs('part_export', { 'exportnum' => $self->exportnum } );
+
+ #check options & values?
+
+ ''; #no error
+}
+
+=back
+
+=head1 BUGS
+
+Possibly.
+
+=head1 SEE ALSO
+
+L<FS::part_export>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_pkg;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch dbh );
+use FS::pkg_svc;
+use FS::agent_type;
+use FS::type_pkgs;
+use FS::Conf;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::part_pkg - Object methods for part_pkg objects
+
+=head1 SYNOPSIS
+
+ use FS::part_pkg;
+
+ $record = new FS::part_pkg \%hash
+ $record = new FS::part_pkg { 'column' => 'value' };
+
+ $custom_record = $template_record->clone;
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ @pkg_svc = $record->pkg_svc;
+
+ $svcnum = $record->svcpart;
+ $svcnum = $record->svcpart( 'svc_acct' );
+
+=head1 DESCRIPTION
+
+An FS::part_pkg object represents a billing item definition. FS::part_pkg
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item pkgpart - primary key (assigned automatically for new billing item definitions)
+
+=item pkg - Text name of this billing item definition (customer-viewable)
+
+=item comment - Text name of this billing item definition (non-customer-viewable)
+
+=item setup - Setup fee expression
+
+=item freq - Frequency of recurring fee
+
+=item recur - Recurring fee expression
+
+=item setuptax - Setup fee tax exempt flag, empty or `Y'
+
+=item recurtax - Recurring fee tax exempt flag, empty or `Y'
+
+=item taxclass - Tax class flag
+
+=item plan - Price plan
+
+=item plandata - Price plan data
+
+=item disabled - Disabled flag, empty or `Y'
+
+=back
+
+setup and recur are evaluated as Safe perl expressions. You can use numbers
+just as you would normally. More advanced semantics are not yet defined.
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new billing item definition. To add the billing item definition to
+the database, see L<"insert">.
+
+=cut
+
+sub table { 'part_pkg'; }
+
+=item 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
+L<"insert">.
+
+=cut
+
+sub clone {
+ my $self = shift;
+ my $class = ref($self);
+ my %hash = $self->hash;
+ $hash{'pkgpart'} = '';
+ $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
+ unless $hash{'comment'} =~ /^\(CUSTOM\) /;
+ #new FS::part_pkg ( \%hash ); # ?
+ new $class ( \%hash ); # ?
+}
+
+=item insert
+
+Adds this billing item definition to the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $conf = new FS::Conf;
+
+ if ( $conf->exists('agent_defaultpkg') ) {
+ foreach my $agent_type ( qsearch('agent_type', {} ) ) {
+ my $type_pkgs = new FS::type_pkgs({
+ 'typenum' => $agent_type->typenum,
+ 'pkgpart' => $self->pkgpart,
+ });
+ my $error = $type_pkgs->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ return "Can't (yet?) delete package definitions.";
+# check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid billing item definition. If
+there is an error, returns the error, otherwise returns false. Called by the
+insert and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $conf = new FS::Conf;
+ if ( $conf->exists('safe-part_pkg') ) {
+
+ my $error = $self->ut_anything('setup')
+ || $self->ut_anything('recur');
+ return $error if $error;
+
+ my $s = $self->setup;
+
+ $s =~ /^\s*\d*\.?\d*\s*$/
+
+ or $s =~ /^my \$d = \$cust_pkg->bill || \$time; \$d += 86400 \* \s*\d+\s*; \$cust_pkg->bill\(\$d\); \$cust_pkg_mod_flag=1; \s*\d*\.?\d*\s*$/
+
+ or do {
+ #log!
+ return "illegal setup: $s";
+ };
+
+ my $r = $self->recur;
+
+ $r =~ /^\s*\d*\.?\d*\s*$/
+
+ #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/
+
+ or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/
+
+ or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; \$sdate = timelocal\(0,0,0,1,\$mon,\$year\); \s*\d*\.?\d*\s*;\s*$/
+
+ or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main\->referral_cust_main_ncancelled\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/
+
+ or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/
+
+ or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\( grep \{ my \$pkgpart = \$_\->pkgpart; grep \{ \$_ == \$pkgpart \} \(\s*(\s*\d+,\s*)*\s*\) \} \$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/
+
+ or $r =~ /^my \$hours = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 3600 \- \s*\d*\.?\d*\s*; \$hours = 0 if \$hours < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$hours;\s*$/
+
+ or $r =~ /^my \$min = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 60 \- \s*\d*\.?\d*\s*; \$min = 0 if \$min < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$min;\s*$/
+
+ or do {
+ #log!
+ return "illegal recur: $r";
+ };
+
+ }
+
+ $self->ut_numbern('pkgpart')
+ || $self->ut_text('pkg')
+ || $self->ut_text('comment')
+ || $self->ut_anything('setup')
+ || $self->ut_number('freq')
+ || $self->ut_anything('recur')
+ || $self->ut_alphan('plan')
+ || $self->ut_anything('plandata')
+ || $self->ut_enum('setuptax', [ '', 'Y' ] )
+ || $self->ut_enum('recurtax', [ '', 'Y' ] )
+ || $self->ut_textn('taxclass')
+ || $self->ut_enum('disabled', [ '', 'Y' ] )
+ ;
+}
+
+=item pkg_svc
+
+Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
+definition (with non-zero quantity).
+
+=cut
+
+sub pkg_svc {
+ my $self = shift;
+ grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item svcpart [ SVCDB ]
+
+Returns the svcpart of a single service definition (see L<FS::part_svc>)
+associated with this billing item definition (see L<FS::pkg_svc>). Returns
+false if there not exactly one service definition with quantity 1, or if
+SVCDB is specified and does not match the svcdb of the service definition,
+
+=cut
+
+sub svcpart {
+ my $self = shift;
+ my $svcdb = shift;
+ my @pkg_svc = $self->pkg_svc;
+ return '' if scalar(@pkg_svc) != 1
+ || $pkg_svc[0]->quantity != 1
+ || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb );
+ $pkg_svc[0]->svcpart;
+}
+
+=item payby
+
+Returns a list of the acceptable payment types for this package. Eventually
+this should come out of a database table and be editable, but currently has the
+following logic instead;
+
+If the package has B<0> setup and B<0> recur, the single item B<BILL> is
+returned, otherwise, the single item B<CARD> is returned.
+
+=cut
+
+sub payby {
+ my $self = shift;
+ #if ( $self->setup == 0 && $self->recur == 0 ) {
+ if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/
+ && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
+ ( 'BILL' );
+ } else {
+ ( 'CARD' );
+ }
+}
+
+=back
+
+=head1 VERSION
+
+$Id: part_pkg.pm,v 1.14 2002-05-09 12:38:39 ivan Exp $
+
+=head1 BUGS
+
+The delete method is unimplemented.
+
+setup and recur semantics are not yet defined (and are implemented in
+FS::cust_bill. hmm.).
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_pop_local;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record; # qw( qsearchs );
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::part_pop_local - Object methods for part_pop_local records
+
+=head1 SYNOPSIS
+
+ use FS::part_pop_local;
+
+ $record = new FS::part_pop_local \%hash;
+ $record = new FS::part_pop_local { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_pop_local object represents a local call area. Each
+FS::part_pop_local record maps a NPA/NXX (area code and exchange) to the POP
+(see L<FS::svc_acct_pop>) which is a local call. FS::part_pop_local inherits
+from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item localnum - primary key (assigned automatically for new accounts)
+
+=item popnum - see L<FS::svc_acct_pop>
+
+=item city
+
+=item state
+
+=item npa - area code
+
+=item nxx - exchange
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new point of presence (if only it were that easy!). To add the
+point of presence to the database, see L<"insert">.
+
+=cut
+
+sub table { 'part_pop_local'; }
+
+=item insert
+
+Adds this point of presence to the database. If there is an error, returns the
+error, otherwise returns false.
+
+=item delete
+
+Removes this point of presence from the database.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid point of presence. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('localnum')
+ or $self->ut_numbern('popnum')
+ or $self->ut_text('city')
+ or $self->ut_text('state')
+ or $self->ut_number('npa')
+ or $self->ut_number('nxx')
+ ;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $
+
+=head1 BUGS
+
+US/CA-centric.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::svc_acct_pop>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_referral;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::part_referral - Object methods for part_referral objects
+
+=head1 SYNOPSIS
+
+ use FS::part_referral;
+
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_referral represents a advertising source - where a customer heard
+of your services. This can be used to track the effectiveness of a particular
+piece of advertising, for example. FS::part_referral inherits from FS::Record.
+The following fields are currently supported:
+
+=over 4
+
+=item refnum - primary key (assigned automatically for new referrals)
+
+=item referral - Text name of this advertising source
+
+=back
+
+=head1 NOTE
+
+These were called B<referrals> before version 1.4.0 - the name was changed
+so as not to be confused with the new customer-to-customer referrals.
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new advertising source. To add the referral to the database, see
+L<"insert">.
+
+=cut
+
+sub table { 'part_referral'; }
+
+=item insert
+
+Adds this advertising source to the database. If there is an error, returns
+the error, otherwise returns false.
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ return "Can't (yet?) delete part_referral records";
+ #need to make sure no customers have this referral!
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid advertising source. If there is
+an error, returns the error, otherwise returns false. Called by the insert and
+replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('refnum')
+ || $self->ut_text('referral')
+ ;
+}
+
+=back
+
+=head1 BUGS
+
+The delete method is unimplemented.
+
+`Advertising source'. Yes, it's a sucky name. The only other ones I could
+come up with were "Marketing channel" and "Heard Abouts" and those are
+definately both worse.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_main>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_svc;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs fields dbh );
+use FS::part_svc_column;
+use FS::part_export;
+use FS::export_svc;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::part_svc - Object methods for part_svc objects
+
+=head1 SYNOPSIS
+
+ use FS::part_svc;
+
+ $record = new FS::part_svc \%hash
+ $record = new FS::part_svc { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_svc represents a service definition. FS::part_svc inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item svcpart - primary key (assigned automatically for new service definitions)
+
+=item svc - text name of this service definition
+
+=item svcdb - table used for this service. See L<FS::svc_acct>,
+L<FS::svc_domain>, and L<FS::svc_forward>, among others.
+
+=item disabled - Disabled flag, empty or `Y'
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new service definition. To add the service definition to the
+database, see L<"insert">.
+
+=cut
+
+sub table { 'part_svc'; }
+
+=item insert EXTRA_FIELDS_ARRAYREF
+
+Adds this service definition to the database. If there is an error, returns
+the error, otherwise returns false.
+
+TODOC:
+
+=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
+
+=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
+
+TODOC: EXTRA_FIELDS_ARRAYREF
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my @fields = ();
+ @fields = @{shift(@_)} if @_;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $svcdb = $self->svcdb;
+# my @rows = map { /^${svcdb}__(.*)$/; $1 }
+# grep ! /_flag$/,
+# grep /^${svcdb}__/,
+# fields('part_svc');
+ foreach my $field (
+ grep { $_ ne 'svcnum'
+ && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
+ } (fields($svcdb), @fields)
+ ) {
+ my $part_svc_column = $self->part_svc_column($field);
+ my $previous = qsearchs('part_svc_column', {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $field,
+ } );
+
+ my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
+ if ( uc($flag) =~ /^([DF])$/ ) {
+ $part_svc_column->setfield('columnflag', $1);
+ $part_svc_column->setfield('columnvalue',
+ $self->getfield($svcdb.'__'.$field)
+ );
+ if ( $previous ) {
+ $error = $part_svc_column->replace($previous);
+ } else {
+ $error = $part_svc_column->insert;
+ }
+ } else {
+ $error = $previous ? $previous->delete : '';
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ return "Can't (yet?) delete service definitions.";
+# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
+}
+
+=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF ] ]
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+TODOC: 1.3-COMPAT
+
+TODOC: EXTRA_FIELDS_ARRAYREF
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change svcdb for an existing service definition!"
+ unless $old->svcdb eq $new->svcdb;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $new->SUPER::replace( $old );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( @_ && $_[0] eq '1.3-COMPAT' ) {
+ shift;
+ my @fields = ();
+ @fields = @{shift(@_)} if @_;
+
+ my $svcdb = $new->svcdb;
+ foreach my $field (
+ grep { $_ ne 'svcnum'
+ && defined( $new->getfield($svcdb.'__'.$_.'_flag') )
+ } (fields($svcdb),@fields)
+ ) {
+ my $part_svc_column = $new->part_svc_column($field);
+ my $previous = qsearchs('part_svc_column', {
+ 'svcpart' => $new->svcpart,
+ 'columnname' => $field,
+ } );
+
+ my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
+ if ( uc($flag) =~ /^([DF])$/ ) {
+ $part_svc_column->setfield('columnflag', $1);
+ $part_svc_column->setfield('columnvalue',
+ $new->getfield($svcdb.'__'.$field)
+ );
+ if ( $previous ) {
+ $error = $part_svc_column->replace($previous);
+ } else {
+ $error = $part_svc_column->insert;
+ }
+ } else {
+ $error = $previous ? $previous->delete : '';
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ } else {
+ $dbh->rollback if $oldAutoCommit;
+ return 'non-1.3-COMPAT interface not yet written';
+ #not yet implemented
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item check
+
+Checks all fields to make sure this is a valid service definition. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+ my $recref = $self->hashref;
+
+ my $error;
+ $error=
+ $self->ut_numbern('svcpart')
+ || $self->ut_text('svc')
+ || $self->ut_alpha('svcdb')
+ || $self->ut_enum('disabled', [ '', 'Y' ] )
+ ;
+ return $error if $error;
+
+ my @fields = eval { fields( $recref->{svcdb} ) }; #might die
+ return "Unknown svcdb!" unless @fields;
+
+##REPLACED BY part_svc_column
+# my $svcdb;
+# foreach $svcdb ( qw(
+# svc_acct svc_acct_sm svc_domain
+# ) ) {
+# my @rows = map { /^${svcdb}__(.*)$/; $1 }
+# grep ! /_flag$/,
+# grep /^${svcdb}__/,
+# fields('part_svc');
+# foreach my $row (@rows) {
+# unless ( $svcdb eq $recref->{svcdb} ) {
+# $recref->{$svcdb.'__'.$row}='';
+# $recref->{$svcdb.'__'.$row.'_flag'}='';
+# next;
+# }
+# $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
+# or return "Illegal flag for $svcdb $row";
+# $recref->{$svcdb.'__'.$row.'_flag'} = $1;
+#
+# my $error = $self->ut_anything($svcdb.'__'.$row);
+# return $error if $error;
+#
+# }
+# }
+
+ ''; #no error
+}
+
+=item part_svc_column COLUMNNAME
+
+Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
+COLUMNNAME, or a new part_svc_column object if none exists.
+
+=cut
+
+sub part_svc_column {
+ my $self = shift;
+ my $columnname = shift;
+ qsearchs('part_svc_column', {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $columnname,
+ }
+ ) or new FS::part_svc_column {
+ 'svcpart' => $self->svcpart,
+ 'columnname' => $columnname,
+ };
+}
+
+=item all_part_svc_column
+
+=cut
+
+sub all_part_svc_column {
+ my $self = shift;
+ qsearch('part_svc_column', { 'svcpart' => $self->svcpart } );
+}
+
+=item part_export
+
+=cut
+
+sub part_export {
+ my $self = shift;
+ map { qsearchs('part_export', { 'exportnum' => $_->exportnum } ) }
+ qsearch('export_svc', { 'svcpart' => $self->svcpart } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: part_svc.pm,v 1.13 2002-04-11 22:05:31 ivan Exp $
+
+=head1 BUGS
+
+Delete is unimplemented.
+
+The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this
+should be fixed.
+
+all_part_svc_column and part_export methods should be documented
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>,
+L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::part_svc_column;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( fields );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::part_svc_column - Object methods for part_svc_column objects
+
+=head1 SYNOPSIS
+
+ use FS::part_svc_column;
+
+ $record = new FS::part_svc_column \%hash
+ $record = new FS::part_svc_column { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::part_svc_column record represents a service definition column
+constraint. FS::part_svc_column inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item columnnum - primary key (assigned automatcially for new records)
+
+=item svcpart - service definition (see L<FS::part_svc>)
+
+=item columnname - column name in part_svc.svcdb table
+
+=item columnvalue - default or fixed value for the column
+
+=item columnflag - null, D or F
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new column constraint. To add the column constraint to the database, see L<"insert">.
+
+=cut
+
+sub table { 'part_svc_column'; }
+
+=item insert
+
+Adds this service definition to the database. If there is an error, returns
+the error, otherwise returns false.
+
+=item delete
+
+Deletes this record from the database. If there is an error, returns the
+error, otherwise returns false.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid record. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('columnnum')
+ || $self->ut_number('svcpart')
+ || $self->ut_alpha('columnname')
+ || $self->ut_anything('columnvalue')
+ ;
+ return $error if $error;
+
+ $self->columnflag =~ /^([DF])$/
+ or return "illegal columnflag ". $self->columnflag;
+ $self->columnflag(uc($1));
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::part_svc>, L<FS::part_pkg>, L<FS::pkg_svc>,
+L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::pkg_svc;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
+use FS::part_pkg;
+use FS::part_svc;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::pkg_svc - Object methods for pkg_svc records
+
+=head1 SYNOPSIS
+
+ use FS::pkg_svc;
+
+ $record = new FS::pkg_svc \%hash;
+ $record = new FS::pkg_svc { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $part_pkg = $record->part_pkg;
+
+ $part_svc = $record->part_svc;
+
+=head1 DESCRIPTION
+
+An FS::pkg_svc record links a billing item definition (see L<FS::part_pkg>) to
+a service definition (see L<FS::part_svc>). FS::pkg_svc inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item pkgpart - Billing item definition (see L<FS::part_pkg>)
+
+=item svcpart - Service definition (see L<FS::part_svc>)
+
+=item quantity - Quantity of this service definition that this billing item
+definition includes
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Create a new record. To add the record to the database, see L<"insert">.
+
+=cut
+
+sub table { 'pkg_svc'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this record from the database. If there is an error, returns the
+error, otherwise returns false.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change pkgpart!" if $old->pkgpart != $new->pkgpart;
+ return "Can't change svcpart!" if $old->svcpart != $new->svcpart;
+
+ $new->SUPER::replace($old);
+}
+
+=item check
+
+Checks all fields to make sure this is a valid record. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error;
+ $error =
+ $self->ut_number('pkgpart')
+ || $self->ut_number('svcpart')
+ || $self->ut_number('quantity')
+ ;
+ return $error if $error;
+
+ return "Unknown pkgpart!" unless $self->part_pkg;
+ return "Unknown svcpart!" unless $self->part_svc;
+
+ ''; #no error
+}
+
+=item part_pkg
+
+Returns the FS::part_pkg object (see L<FS::part_pkg>).
+
+=cut
+
+sub part_pkg {
+ my $self = shift;
+ qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item part_svc
+
+Returns the FS::part_svc object (see L<FS::part_svc>).
+
+=cut
+
+sub part_svc {
+ my $self = shift;
+ qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::part_pkg>, L<FS::part_svc>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::port;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
+use FS::nas;
+use FS::session;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::port - Object methods for port records
+
+=head1 SYNOPSIS
+
+ use FS::port;
+
+ $record = new FS::port \%hash;
+ $record = new FS::port { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $session = $port->session;
+
+=head1 DESCRIPTION
+
+An FS::port object represents an individual port on a NAS. FS::port inherits
+from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item portnum - primary key
+
+=item ip - IP address of this port
+
+=item nasport - port number on the NAS
+
+=item nasnum - NAS this port is on - see L<FS::nas>
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new port. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'port'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+ my $error =
+ $self->ut_numbern('portnum')
+ || $self->ut_ipn('ip')
+ || $self->ut_numbern('nasport')
+ || $self->ut_number('nasnum');
+ ;
+ return $error if $error;
+ return "Either ip or nasport must be specified"
+ unless $self->ip || $self->nasport;
+ return "Unknown nasnum"
+ unless qsearchs('nas', { 'nasnum' => $self->nasnum } );
+ ''; #no error
+}
+
+=item session
+
+Returns the currently open session on this port, or if no session is currently
+open, the most recent session. See L<FS::session>.
+
+=cut
+
+sub session {
+ my $self = shift;
+ qsearchs('session', { 'portnum' => $self->portnum }, '*',
+ 'ORDER BY login DESC LIMIT 1' );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+The session method won't deal well if you have multiple open sessions on a
+port, for example if your RADIUS server drops B<stop> records. Suggestions for
+how to deal with this sort of lossage welcome; should we close the session
+when we get a new session on that port? Tag it as invalid somehow? Close it
+one second after it was opened? *sigh* Maybe FS::session shouldn't let you
+create overlapping sessions, at least folks will find out their logging is
+dropping records.
+
+If you think the above refers multiple user logins you need to read the
+manpages again.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::prepay_credit;
+
+use strict;
+use vars qw( @ISA );
+#use FS::Record qw( qsearch qsearchs );
+use FS::Record qw();
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::prepay_credit - Object methods for prepay_credit records
+
+=head1 SYNOPSIS
+
+ use FS::prepay_credit;
+
+ $record = new FS::prepay_credit \%hash;
+ $record = new FS::prepay_credit {
+ 'identifier' => '4198123455512121'
+ 'amount' => '19.95',
+ };
+
+ $record = new FS::prepay_credit {
+ 'identifier' => '4198123455512121'
+ 'seconds' => '7200',
+ };
+
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::table_name object represents an pre--paid credit, such as a pre-paid
+"calling card". FS::prepay_credit inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item field - description
+
+=item identifier - identifier entered by the user to receive the credit
+
+=item amount - amount of the credit
+
+=item seconds - time amount of credit (see L<FS::svc_acct/seconds>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new pre-paid credit. To add the example to the database, see
+L<"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 I<hash> method.
+
+=cut
+
+sub table { 'prepay_credit'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+=item check
+
+Checks all fields to make sure this is a valid pre-paid credit. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $identifier = $self->identifier;
+ $identifier =~ s/\W//g; #anything else would just confuse things
+ $self->identifier($identifier);
+
+ $self->ut_numbern('prepaynum')
+ || $self->ut_alpha('identifier')
+ || $self->ut_money('amount')
+ || $self->utnumbern('seconds')
+ ;
+
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::svc_acct>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::queue;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK $conf );
+use Exporter;
+use FS::UID;
+use FS::Conf;
+use FS::Record qw( qsearch qsearchs dbh );
+#use FS::queue;
+use FS::queue_arg;
+use FS::queue_depend;
+use FS::cust_svc;
+
+@ISA = qw(FS::Record);
+@EXPORT_OK = qw( joblisting );
+
+$FS::UID::callback{'FS::queue'} = sub {
+ $conf = new FS::Conf;
+};
+
+=head1 NAME
+
+FS::queue - Object methods for queue records
+
+=head1 SYNOPSIS
+
+ use FS::queue;
+
+ $record = new FS::queue \%hash;
+ $record = new FS::queue { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::queue object represents an queued job. FS::queue inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item jobnum - primary key
+
+=item job - fully-qualified subroutine name
+
+=item status - job status
+
+=item statustext - freeform text status message
+
+=item _date - UNIX timestamp
+
+=item svcnum - optional link to service (see L<FS::cust_svc>)
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new job. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'queue'; }
+
+=item insert [ ARGUMENT, ARGUMENT... ]
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+If any arguments are supplied, a queue_arg record for each argument is also
+created (see L<FS::queue_arg>).
+
+=cut
+
+#false laziness w/part_export.pm
+sub insert {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $arg ( @_ ) {
+ my $queue_arg = new FS::queue_arg ( {
+ 'jobnum' => $self->jobnum,
+ 'arg' => $arg,
+ } );
+ $error = $queue_arg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+}
+
+=item delete
+
+Delete this record from the database. Any corresponding queue_arg records are
+deleted as well
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my @del = qsearch( 'queue_arg', { 'jobnum' => $self->jobnum } );
+ push @del, qsearch( 'queue_depend', { 'depend_jobnum' => $self->jobnum } );
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $del ( @del ) {
+ $error = $del->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+
+}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid job. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+ my $error =
+ $self->ut_numbern('jobnum')
+ || $self->ut_anything('job')
+ || $self->ut_numbern('_date')
+ || $self->ut_enum('status',['', qw( new locked failed )])
+ || $self->ut_textn('statustext')
+ || $self->ut_numbern('svcnum')
+ ;
+ return $error if $error;
+
+ $error = $self->ut_foreign_keyn('svcnum', 'cust_svc', 'svcnum');
+ $self->svcnum('') if $error;
+
+ $self->status('new') unless $self->status;
+ $self->_date(time) unless $self->_date;
+
+ ''; #no error
+}
+
+=item args
+
+Returns a list of the arguments associated with this job.
+
+=cut
+
+sub args {
+ my $self = shift;
+ map $_->arg, qsearch( 'queue_arg',
+ { 'jobnum' => $self->jobnum },
+ '',
+ 'ORDER BY argnum'
+ );
+}
+
+=item cust_svc
+
+Returns the FS::cust_svc object associated with this job, if any.
+
+=cut
+
+sub cust_svc {
+ my $self = shift;
+ qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
+}
+
+=item queue_depend
+
+Returns the FS::queue_depend objects associated with this job, if any.
+
+=cut
+
+sub queue_depend {
+ my $self = shift;
+ qsearch('queue_depend', { 'jobnum' => $self->jobnum } );
+}
+
+
+=item depend_insert OTHER_JOBNUM
+
+Inserts a dependancy for this job - it will not be run until the other job
+specified completes. If there is an error, returns the error, otherwise
+returns false.
+
+When using job dependancies, you should wrap the insertion of all relevant jobs
+in a database transaction.
+
+=cut
+
+sub depend_insert {
+ my($self, $other_jobnum) = @_;
+ my $queue_depend = new FS::queue_depend (
+ 'jobnum' => $self->jobnum,
+ 'depend_jobnum' => $other_jobnum,
+ );
+ $queue_depend->insert;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item joblisting HASHREF NOACTIONS
+
+=cut
+
+sub joblisting {
+ my($hashref, $noactions) = @_;
+
+ use Date::Format;
+ use FS::CGI;
+
+ my @queue = qsearch( 'queue', $hashref );
+ return '' unless scalar(@queue);
+
+ my $p = FS::CGI::popurl(2);
+
+ my $html = qq!<FORM ACTION="$p/misc/queue.cgi" METHOD="POST">!.
+ FS::CGI::table(). <<END;
+ <TR>
+ <TH COLSPAN=2>Job</TH>
+ <TH>Args</TH>
+ <TH>Date</TH>
+ <TH>Status</TH>
+END
+ $html .= '<TH>Account</TH>' unless $hashref->{svcnum};
+ $html .= '</TR>';
+
+ my $dangerous = $conf->exists('queue_dangerous_controls');
+
+ my $areboxes = 0;
+
+ foreach my $queue ( sort {
+ $a->getfield('jobnum') <=> $b->getfield('jobnum')
+ } @queue ) {
+ my $queue_hashref = $queue->hashref;
+ my $jobnum = $queue->jobnum;
+
+ my $args;
+ if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) {
+ $args = join(' ', $queue->args);
+ } else {
+ $args = '';
+ }
+
+ my $date = time2str( "%a %b %e %T %Y", $queue->_date );
+ my $status = $queue->status;
+ $status .= ': '. $queue->statustext if $queue->statustext;
+ my @queue_depend = $queue->queue_depend;
+ $status .= ' (waiting for '.
+ join(', ', map { $_->other_jobnum } @queue_depend ).
+ ')'
+ if @queue_depend;
+ my $changable = $dangerous
+ || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ );
+ if ( $changable ) {
+ $status .=
+ qq! ( <A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=new">retry</A> |!.
+ qq! <A HREF="$p/misc/queue.cgi?jobnum=$jobnum&action=del">remove</A> )!;
+ }
+ my $cust_svc = $queue->cust_svc;
+
+ $html .= <<END;
+ <TR>
+ <TD>$jobnum</TD>
+ <TD>$queue_hashref->{job}</TD>
+ <TD>$args</TD>
+ <TD>$date</TD>
+ <TD>$status</TD>
+END
+
+ unless ( $hashref->{svcnum} ) {
+ my $account;
+ if ( $cust_svc ) {
+ my $table = $cust_svc->part_svc->svcdb;
+ my $label = ( $cust_svc->label )[1];
+ $account = qq!<A HREF="../view/$table.cgi?!. $queue->svcnum.
+ qq!">$label</A>!;
+ } else {
+ $account = '';
+ }
+ $html .= "<TD>$account</TD>";
+ }
+
+ if ( $changable ) {
+ $areboxes=1;
+ $html .=
+ qq!<TD><INPUT NAME="jobnum$jobnum" TYPE="checkbox" VALUE="1"></TD>!;
+
+ }
+
+ $html .= '</TR>';
+
+}
+
+ $html .= '</TABLE>';
+
+ if ( $areboxes ) {
+ $html .= '<BR><INPUT TYPE="submit" NAME="action" VALUE="retry selected">'.
+ '<INPUT TYPE="submit" NAME="action" VALUE="remove selected"><BR>';
+ }
+
+ $html;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: queue.pm,v 1.13 2002-05-15 14:00:32 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::queue_arg;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::queue_arg - Object methods for queue_arg records
+
+=head1 SYNOPSIS
+
+ use FS::queue_arg;
+
+ $record = new FS::queue_arg \%hash;
+ $record = new FS::queue_arg { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::queue_arg object represents job argument. FS::queue_arg inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item argnum - primary key
+
+=item jobnum - see L<FS::queue>
+
+=item arg - argument
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new argument. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'queue_arg'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid argument. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+ my $error =
+ $self->ut_numbern('argnum')
+ || $self->ut_numbern('jobnum')
+ || $self->ut_anything('arg')
+ ;
+ return $error if $error;
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::queue>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::queue_depend;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::queue;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::queue_depend - Object methods for queue_depend records
+
+=head1 SYNOPSIS
+
+ use FS::queue_depend;
+
+ $record = new FS::queue_depend \%hash;
+ $record = new FS::queue_depend { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::queue_depend object represents an job dependancy. FS::queue_depend
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item dependnum - primary key
+
+=item jobnum - source jobnum (see L<FS::queue>).
+
+=item depend_jobnum - dependancy jobnum (see L<FS::queue>)
+
+=back
+
+The job specified by B<jobnum> depends on the job specified B<depend_jobnum> -
+the B<jobnum> job will not be run until the B<depend_jobnum> job has completed
+sucessfully (or manually removed).
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new dependancy. To add the dependancy to the database, see
+L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'queue_depend'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid dependancy. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('dependnum')
+ || $self->ut_foreign_key('jobnum', 'queue', 'jobnum')
+ || $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum')
+ ;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::queue>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::raddb;
+use vars qw(%attrib);
+
+%attrib = (
+ 'ascend_bi_directional_au' => 'Ascend-Bi-Directional-Auth',
+ 'h323_connect_time' => 'h323-connect-time',
+ 'connect_rate' => 'Connect-Rate',
+ 'bind_auth_service_grp' => 'Bind_Auth_Service_Grp',
+ 'usr_callback_type' => 'USR-Callback-Type',
+ 'erx_primary_wins' => 'ERX-Primary-Wins',
+ 'ascend_x25_x121_address' => 'Ascend-X25-X121-Address',
+ 'usr_log_filter_packets' => 'USR-Log-Filter-Packets',
+ 'annex_addr_resolution_pr' => 'Annex-Addr-Resolution-Protocol',
+ 'usr_ip_rip_simple_auth_p' => 'USR-IP-RIP-Simple-Auth-Password',
+ 'dialback_name' => 'Dialback-Name',
+ 'x_ascend_fr_dce_n392' => 'X-Ascend-FR-DCE-N392',
+ 'usr_host_type' => 'USR-Host-Type',
+ 'le_modem_info' => 'LE-Modem-Info',
+ 'x_ascend_menu_selector' => 'X-Ascend-Menu-Selector',
+ 'x_ascend_fr_dce_n393' => 'X-Ascend-FR-DCE-N393',
+ 'ascend_ip_direct' => 'Ascend-IP-Direct',
+ 'x_ascend_pre_output_octe' => 'X-Ascend-Pre-Output-Octets',
+ 'x_ascend_ft1_caller' => 'X-Ascend-FT1-Caller',
+ 'usr_last_callers_number_' => 'USR-Last-Callers-Number-ANI',
+ 'usr_rmmie_product_code' => 'USR-RMMIE-Product-Code',
+ 'usr_igmp_robustness' => 'USR-IGMP-Robustness',
+ 'ms_chap2_success' => 'MS-CHAP2-Success',
+ 'ascend_home_agent_passwo' => 'Ascend-Home-Agent-Password',
+ 'acc_bridging_support' => 'Acc-Bridging-Support',
+ 'annex_transmit_speed' => 'Annex-Transmit-Speed',
+ 'old_password' => 'Old-Password',
+ 'x_ascend_metric' => 'X-Ascend-Metric',
+ 'acc_clearing_location' => 'Acc-Clearing-Location',
+ 'ascend_multilink_id' => 'Ascend-Multilink-ID',
+ 'ascend_egress_enabled' => 'Ascend-Egress-Enabled',
+ 'usr_bridging' => 'USR-Bridging',
+ 'ascend_assign_ip_server' => 'Ascend-Assign-IP-Server',
+ 'acc_dns_server_sec' => 'Acc-Dns-Server-Sec',
+ 'ascend_home_agent_ip_add' => 'Ascend-Home-Agent-IP-Addr',
+ 'usr_dnis_reauthenticatio' => 'USR-DNIS-ReAuthentication',
+ 'acc_modem_error_protocol' => 'Acc-Modem-Error-Protocol',
+ 'ascend_backup' => 'Ascend-Backup',
+ 'usr_connect_time' => 'USR-Connect-Time',
+ 'ascend_cbcp_mode' => 'Ascend-CBCP-Mode',
+ 'usr_rmmie_x2_status' => 'USR-RMMIE-x2-Status',
+ 'ascend_multicast_gleave_' => 'Ascend-Multicast-GLeave-Delay',
+ 'erx_ingress_statistics' => 'ERX-Ingress-Statistics',
+ 'cisco_nas_port' => 'Cisco-NAS-Port',
+ 'le_admin_group' => 'LE-Admin-Group',
+ 'annex_mrru' => 'Annex-MRRU',
+ 'x_ascend_add_seconds' => 'X-Ascend-Add-Seconds',
+ 'ascend_token_expiry' => 'Ascend-Token-Expiry',
+ 'usr_igmp_maximum_respons' => 'USR-IGMP-Maximum-Response-Time',
+ 'ascend_calling_id_presen' => 'Ascend-Calling-Id-Presentatn',
+ 'connect_info' => 'Connect-Info',
+ 'ascend_access_intercept_' => 'Ascend-Access-Intercept-LEA',
+ 'x_ascend_dba_monitor' => 'X-Ascend-DBA-Monitor',
+ 'client_dns_pri' => 'Client_DNS_Pri',
+ 'ip_host_addr' => 'Ip_Host_Addr',
+ 'callback_id' => 'Callback-Id',
+ 'acct_mcast_out_octets' => 'Acct_Mcast_Out_Octets',
+ 'acct_input_octets_64' => 'Acct_Input_Octets_64',
+ 'tunnel_function' => 'Tunnel_Function',
+ 'ascend_fr_direct_profile' => 'Ascend-FR-Direct-Profile',
+ 'h323_incoming_conf_id' => 'h323-incoming-conf-id',
+ 'ascend_ppp_vj_1172' => 'Ascend-PPP-VJ-1172',
+ 'ms_new_arap_password' => 'MS-New-ARAP-Password',
+ 'h323_voice_quality' => 'h323-voice-quality',
+ 'framed_appletalk_network' => 'Framed-AppleTalk-Network',
+ 'bind_int_interface_name' => 'Bind_Int_Interface_Name',
+ 'event_timestamp' => 'Event-Timestamp',
+ 'ascend_bir_enable' => 'Ascend-BIR-Enable',
+ 'usr_fallback_enabled' => 'USR-Fallback-Enabled',
+ 'ascend_dhcp_pool_number' => 'Ascend-DHCP-Pool-Number',
+ 'acct_session_id' => 'Acct-Session-Id',
+ 'ascend_private_route_req' => 'Ascend-Private-Route-Required',
+ 'usr_rmmie_pwrlvl_farecho' => 'USR-RMMIE-PwrLvl-FarEcho-Canc',
+ 'usr_at_input_filter' => 'USR-AT-Input-Filter',
+ 'erx_egress_statistics' => 'ERX-Egress-Statistics',
+ 'x_ascend_call_type' => 'X-Ascend-Call-Type',
+ 'acct_tunnel_client_endpo' => 'Acct-Tunnel-Client-Endpoint',
+ 'x_ascend_assign_ip_clien' => 'X-Ascend-Assign-IP-Client',
+ 'ascend_if_netmask' => 'Ascend-IF-Netmask',
+ 'ascend_dhcp_maximum_leas' => 'Ascend-DHCP-Maximum-Leases',
+ 'usr_at_output_filter' => 'USR-AT-Output-Filter',
+ 'usr_rad_dvmrp_metric' => 'USR-Rad-Dvmrp-Metric',
+ 'rate_limit_rate' => 'Rate_Limit_Rate',
+ 'prefix' => 'Prefix',
+ 'ascend_x25_pad_banner' => 'Ascend-X25-Pad-Banner',
+ 'usr_rmmie_rcv_pwrlvl_375' => 'USR-RMMIE-Rcv-PwrLvl-3750Hz',
+ 'x_ascend_user_acct_key' => 'X-Ascend-User-Acct-Key',
+ 'group_name' => 'Group-Name',
+ 'ascend_receive_secret' => 'Ascend-Receive-Secret',
+ 'reply_message' => 'Reply-Message',
+ 'le_nat_sess_dir_fail_act' => 'LE-NAT-Sess-Dir-Fail-Action',
+ 'framed_callback_id' => 'Framed-Callback-Id',
+ 'cisco_disconnect_cause' => 'Cisco-Disconnect-Cause',
+ 'stripped_user_name' => 'Stripped-User-Name',
+ 'annex_keypress_timeout' => 'Annex-Keypress-Timeout',
+ 'annex_receive_speed' => 'Annex-Receive-Speed',
+ 'ms_chap_domain' => 'MS-CHAP-Domain',
+ 'ascend_atm_connect_group' => 'Ascend-ATM-Connect-Group',
+ 'usr_send_name' => 'USR-Send-Name',
+ 'usr_local_framed_ip_addr' => 'USR-Local-Framed-IP-Addr',
+ 'erx_alternate_cli_vroute' => 'ERX-Alternate-Cli-Vrouter-Name',
+ 'usr_fallback_limit' => 'USR-Fallback-Limit',
+ 'ascend_pri_number_type' => 'Ascend-PRI-Number-Type',
+ 'x_ascend_minimum_channel' => 'X-Ascend-Minimum-Channels',
+ 'x_ascend_fr_direct_dlci' => 'X-Ascend-FR-Direct-DLCI',
+ 'ascend_fr_link_mgt' => 'Ascend-FR-Link-Mgt',
+ 'annex_host_allow' => 'Annex-Host-Allow',
+ 'x_ascend_force_56' => 'X-Ascend-Force-56',
+ 'police_burst' => 'Police_Burst',
+ 'pvc_profile_name' => 'PVC_Profile_Name',
+ 'ms_filter' => 'MS-Filter',
+ 'rate_limit_burst' => 'Rate_Limit_Burst',
+ 'ascend_number_sessions' => 'Ascend-Number-Sessions',
+ 'cisco_call_filter' => 'Cisco-Call-Filter',
+ 'erx_igmp_enable' => 'ERX-Igmp-Enable',
+ 'ascend_filter_required' => 'Ascend-Filter-Required',
+ 'erx_cli_allow_all_vr_acc' => 'ERX-Cli-Allow-All-VR-Access',
+ 'acc_callback_delay' => 'Acc-Callback-Delay',
+ 'usr_default_dte_data_rat' => 'USR-Default-DTE-Data-Rate',
+ 'le_ip_pool' => 'LE-IP-Pool',
+ 'cisco_pre_output_packets' => 'Cisco-Pre-Output-Packets',
+ 'x_ascend_group' => 'X-Ascend-Group',
+ 'usr_channel_connected_to' => 'USR-Channel-Connected-To',
+ 'usr_ipx_rip_output_filte' => 'USR-IPX-RIP-Output-Filter',
+ 'usr_esn' => 'USR-ESN',
+ 'annex_user_level' => 'Annex-User-Level',
+ 'x_ascend_primary_home_ag' => 'X-Ascend-Primary-Home-Agent',
+ 'no_such_attribute' => 'No-Such-Attribute',
+ 'x_ascend_pri_number_type' => 'X-Ascend-PRI-Number-Type',
+ 'ms_mppe_send_key' => 'MS-MPPE-Send-Key',
+ 'usr_actual_voltage' => 'USR-Actual-Voltage',
+ 'annex_acct_servers' => 'Annex-Acct-Servers',
+ 'ascend_handle_ipx' => 'Ascend-Handle-IPX',
+ 'cisco_xmit_rate' => 'Cisco-Xmit-Rate',
+ 'acc_service_profile' => 'Acc-Service-Profile',
+ 'x_ascend_ara_pw' => 'X-Ascend-Ara-PW',
+ 'ascend_ckt_type' => 'Ascend-Ckt-Type',
+ 'cisco_data_rate' => 'Cisco-Data-Rate',
+ 'group' => 'Group',
+ 'nas_port' => 'NAS-Port',
+ 'usr_ipx_call_output_filt' => 'USR-IPX-Call-Output-Filter',
+ 'tunnel_type' => 'Tunnel-Type',
+ 'usr_rmmie_manufacturer_i' => 'USR-RMMIE-Manufacturer-ID',
+ 'user_name_is_star' => 'User-Name-Is-Star',
+ 'usr_call_arrival_in_gmt' => 'USR-Call-Arrival-in-GMT',
+ 'x_ascend_number_sessions' => 'X-Ascend-Number-Sessions',
+ 'ascend_send_auth' => 'Ascend-Send-Auth',
+ 'user_service_type' => 'User-Service-Type',
+ 'annex_cli_filter' => 'Annex-CLI-Filter',
+ 'erx_cli_initial_access_l' => 'ERX-Cli-Initial-Access-Level',
+ 'ascend_call_direction' => 'Ascend-Call-Direction',
+ 'usr_chassis_temp_thresho' => 'USR-Chassis-Temp-Threshold',
+ 'usr_pw_usr_ofilter_ipx' => 'USR-PW_USR_OFilter_IPX',
+ 'tunnel_session_auth' => 'Tunnel_Session_Auth',
+ 'x_ascend_connect_progres' => 'X-Ascend-Connect-Progress',
+ 'ascend_atm_connect_vci' => 'Ascend-ATM-Connect-Vci',
+ 'x_ascend_maximum_call_du' => 'X-Ascend-Maximum-Call-Duration',
+ 'usr_rmmie_planned_discon' => 'USR-RMMIE-Planned-Disconnect',
+ 'x_ascend_fr_dte_n392' => 'X-Ascend-FR-DTE-N392',
+ 'login_host' => 'Login-Host',
+ 'ascend_user_acct_host' => 'Ascend-User-Acct-Host',
+ 'x_ascend_fr_dte_n393' => 'X-Ascend-FR-DTE-N393',
+ 'acc_tunnel_secret' => 'Acc-Tunnel-Secret',
+ 'usr_at_rtmp_input_filter' => 'USR-AT-RTMP-Input-Filter',
+ 'framed_protocol' => 'Framed-Protocol',
+ 'login_callback_number' => 'Login-Callback-Number',
+ 'ascend_dsl_rate_type' => 'Ascend-Dsl-Rate-Type',
+ 'ascend_pre_output_packet' => 'Ascend-Pre-Output-Packets',
+ 'proxy_state' => 'Proxy-State',
+ 'usr_pw_usr_ofilter_ip' => 'USR-PW_USR_OFilter_IP',
+ 'cisco_data_filter' => 'Cisco-Data-Filter',
+ 'cisco_target_util' => 'Cisco-Target-Util',
+ 'usr_ids0_call_type' => 'USR-IDS0-Call-Type',
+ 'usr_blocks_resent' => 'USR-Blocks-Resent',
+ 'usr_terminal_type' => 'USR-Terminal-Type',
+ 'ascend_history_weigh_typ' => 'Ascend-History-Weigh-Type',
+ 'framed_routing' => 'Framed-Routing',
+ 'ascend_client_assign_dns' => 'Ascend-Client-Assign-DNS',
+ 'ascend_atm_group' => 'Ascend-ATM-Group',
+ 'bind_bypass_bypass' => 'Bind_Bypass_Bypass',
+ 'le_ip_gateway' => 'LE-IP-Gateway',
+ 'cisco_ip_pool_definition' => 'Cisco-IP-Pool-Definition',
+ 'x_ascend_maximum_time' => 'X-Ascend-Maximum-Time',
+ 'usr_request_type' => 'USR-Request-Type',
+ 'usr_call_arrival_time' => 'USR-Call-Arrival-Time',
+ 'tunnel_domain' => 'Tunnel_Domain',
+ 'ms_chap_nt_enc_pw' => 'MS-CHAP-NT-Enc-PW',
+ 'shiva_calling_number' => 'Shiva-Calling-Number',
+ 'ip_address_pool_name' => 'Ip_Address_Pool_Name',
+ 'erx_secondary_dns' => 'ERX-Secondary-Dns',
+ 'x_ascend_pre_input_octet' => 'X-Ascend-Pre-Input-Octets',
+ 'ascend_home_agent_udp_po' => 'Ascend-Home-Agent-UDP-Port',
+ 'le_nat_outsource_inmap' => 'LE-NAT-Outsource-Inmap',
+ 'x_ascend_home_agent_pass' => 'X-Ascend-Home-Agent-Password',
+ 'tunnel_password' => 'Tunnel-Password',
+ 'usr_compression_type' => 'USR-Compression-Type',
+ 'usr_connect_speed' => 'USR-Connect-Speed',
+ 'usr_connect_time_limit' => 'USR-Connect-Time-Limit',
+ 'arap_challenge_response' => 'ARAP-Challenge-Response',
+ 'ms_link_utilization_thre' => 'MS-Link-Utilization-Threshold',
+ 'usr_mp_edo' => 'USR-MP-EDO',
+ 'usr_primary_nbns_server' => 'USR-Primary_NBNS_Server',
+ 'usr_imsi' => 'USR-IMSI',
+ 'ascend_fr_direct' => 'Ascend-FR-Direct',
+ 'ascend_vrouter_name' => 'Ascend-VRouter-Name',
+ 'ascend_preempt_limit' => 'Ascend-Preempt-Limit',
+ 'ascend_ip_pool_definitio' => 'Ascend-IP-Pool-Definition',
+ 'h323_gw_id' => 'h323-gw-id',
+ 'usr_framed_ipx_route' => 'USR-Framed-IPX-Route',
+ 'x_ascend_maximum_channel' => 'X-Ascend-Maximum-Channels',
+ 'login_lat_node' => 'Login-LAT-Node',
+ 'acct_session_time' => 'Acct-Session-Time',
+ 'ascend_disconnect_cause' => 'Ascend-Disconnect-Cause',
+ 'ms_mppe_encryption_polic' => 'MS-MPPE-Encryption-Policy',
+ 'ms_ras_version' => 'MS-RAS-Version',
+ 'class' => 'Class',
+ 'caller_id' => 'Caller-ID',
+ 'ascend_access_intercept_' => 'Ascend-Access-Intercept-Log',
+ 'ascend_service_type' => 'Ascend-Service-Type',
+ 'ascend_h323_dialed_time' => 'Ascend-H323-Dialed-Time',
+ 'exec_program_wait' => 'Exec-Program-Wait',
+ 'ascend_x25_nui_password_' => 'Ascend-X25-Nui-Password-Prompt',
+ 'ascend_appletalk_peer_mo' => 'Ascend-Appletalk-Peer-Mode',
+ 'login_lat_group' => 'Login-LAT-Group',
+ 'strip_user_name' => 'Strip-User-Name',
+ 'nas_ip_address' => 'NAS-IP-Address',
+ 'ascend_maximum_time' => 'Ascend-Maximum-Time',
+ 'erx_atm_pcr' => 'ERX-Atm-PCR',
+ 'ascend_client_primary_dn' => 'Ascend-Client-Primary-DNS',
+ 'auth_type' => 'Auth-Type',
+ 'ascend_secondary_home_ag' => 'Ascend-Secondary-Home-Agent',
+ 'x_ascend_idle_limit' => 'X-Ascend-Idle-Limit',
+ 'ms_ras_vendor' => 'MS-RAS-Vendor',
+ 'ascend_pre_input_packets' => 'Ascend-Pre-Input-Packets',
+ 'ascend_bridge' => 'Ascend-Bridge',
+ 'h323_redirect_number' => 'h323-redirect-number',
+ 'usr_simplified_mnp_level' => 'USR-Simplified-MNP-Levels',
+ 'annex_edo' => 'Annex-EDO',
+ 'acc_nbns_server_sec' => 'Acc-Nbns-Server-Sec',
+ 'ascend_cbcp_trunk_group' => 'Ascend-CBCP-Trunk-Group',
+ 'x_ascend_data_svc' => 'X-Ascend-Data-Svc',
+ 'le_terminate_detail' => 'LE-Terminate-Detail',
+ 'acct_output_octets' => 'Acct-Output-Octets',
+ 'usr_calling_party_number' => 'USR-Calling-Party-Number',
+ 'x_ascend_dhcp_maximum_le' => 'X-Ascend-DHCP-Maximum-Leases',
+ 'ascend_force_56' => 'Ascend-Force-56',
+ 'shiva_acct_serv_switch' => 'Shiva-Acct-Serv-Switch',
+ 'tunnel_algorithm' => 'Tunnel_Algorithm',
+ 'usr_max_channels' => 'USR-Max-Channels',
+ 'usr_port_tap_priority' => 'USR-Port-Tap-Priority',
+ 'le_nat_outmap' => 'LE-NAT-Outmap',
+ 'usr_call_connecting_time' => 'USR-Call-Connecting-Time',
+ 'usr_supports_tags' => 'USR-Supports-Tags',
+ 'idle_timeout' => 'Idle-Timeout',
+ 'usr_ip_rip_input_filter' => 'USR-IP-RIP-Input-Filter',
+ 'erx_ingress_policy_name' => 'ERX-Ingress-Policy-Name',
+ 'usr_pw_cutoff' => 'USR-PW_Cutoff',
+ 'usr_channel_expansion' => 'USR-Channel-Expansion',
+ 'x_ascend_send_secret' => 'X-Ascend-Send-Secret',
+ 'h323_call_origin' => 'h323-call-origin',
+ 'h323_preferred_lang' => 'h323-preferred-lang',
+ 'ascend_base_channel_coun' => 'Ascend-Base-Channel-Count',
+ 'bind_auth_context' => 'Bind_Auth_Context',
+ 'ascend_calling_id_number' => 'Ascend-Calling-Id-Number-Plan',
+ 'ascend_modem_shelfno' => 'Ascend-Modem-ShelfNo',
+ 'tunnel_police_burst' => 'Tunnel_Police_Burst',
+ 'pvc_circuit_padding' => 'PVC_Circuit_Padding',
+ 'acc_ml_call_threshold' => 'Acc-ML-Call-Threshold',
+ 'usr_end_time' => 'USR-End-Time',
+ 'usr_ipx' => 'USR-IPX',
+ 'ms_primary_dns_server' => 'MS-Primary-DNS-Server',
+ 'ascend_dsl_upstream_limi' => 'Ascend-Dsl-Upstream-Limit',
+ 'usr_blocks_sent' => 'USR-Blocks-Sent',
+ 'bind_dot1q_vlan_tag_id' => 'Bind_Dot1q_Vlan_Tag_Id',
+ 'ascend_private_route' => 'Ascend-Private-Route',
+ 'usr_back_channel_data_ra' => 'USR-Back-Channel-Data-Rate',
+ 'ascend_dropped_packets' => 'Ascend-Dropped-Packets',
+ 'cisco_route_ip' => 'Cisco-Route-IP',
+ 'nas_identifier' => 'NAS-Identifier',
+ 'ascend_presession_time' => 'Ascend-PreSession-Time',
+ 'usr_call_type' => 'USR-Call-Type',
+ 'usr_acct_reason_code' => 'USR-Acct-Reason-Code',
+ 'acc_dialout_auth_passwor' => 'Acc-Dialout-Auth-Password',
+ 'acc_connect_tx_speed' => 'Acc-Connect-Tx-Speed',
+ 'cisco_pre_input_octets' => 'Cisco-Pre-Input-Octets',
+ 'x_ascend_send_passwd' => 'X-Ascend-Send-Passwd',
+ 'ascend_bir_bridge_group' => 'Ascend-BIR-Bridge-Group',
+ 'ascend_fr_profile_name' => 'Ascend-FR-Profile-Name',
+ 'ascend_group' => 'Ascend-Group',
+ 'crypt_password' => 'Crypt-Password',
+ 'usr_port_tap_address' => 'USR-Port-Tap-Address',
+ 'le_nat_outsource_outmap' => 'LE-NAT-Outsource-Outmap',
+ 'usr_vpn_encrypter' => 'USR-VPN-Encrypter',
+ 'usr_blocks_received' => 'USR-Blocks-Received',
+ 'tunnel_group' => 'Tunnel_Group',
+ 'ascend_shared_profile_en' => 'Ascend-Shared-Profile-Enable',
+ 'replicate_to_realm' => 'Replicate-To-Realm',
+ 'usr_mobile_ip_address' => 'USR-Mobile-IP-Address',
+ 'x_ascend_authen_alias' => 'X-Ascend-Authen-Alias',
+ 'ascend_fr_linkup' => 'Ascend-FR-LinkUp',
+ 'tunnel_rate_limit_rate' => 'Tunnel_Rate_Limit_Rate',
+ 'acc_access_community' => 'Acc-Access-Community',
+ 'x_ascend_presession_time' => 'X-Ascend-PreSession-Time',
+ 'ms_chap_cpw_1' => 'MS-CHAP-CPW-1',
+ 'ms_chap_cpw_2' => 'MS-CHAP-CPW-2',
+ 'erx_primary_dns' => 'ERX-Primary-Dns',
+ 'ascend_fr_circuit_name' => 'Ascend-FR-Circuit-Name',
+ 'ascend_token_immediate' => 'Ascend-Token-Immediate',
+ 'cisco_idle_limit' => 'Cisco-Idle-Limit',
+ 'usr_speed_of_connection' => 'USR-Speed-Of-Connection',
+ 'shiva_links_in_bundle' => 'Shiva-Links-In-Bundle',
+ 'x_ascend_fr_profile_name' => 'X-Ascend-FR-Profile-Name',
+ 'cisco_multilink_id' => 'Cisco-Multilink-ID',
+ 'x_ascend_preempt_limit' => 'X-Ascend-Preempt-Limit',
+ 'ascend_assign_ip_client' => 'Ascend-Assign-IP-Client',
+ 'usr_iwf_ip_address' => 'USR-IWF-IP-Address',
+ 'acct_unique_session_id' => 'Acct-Unique-Session-Id',
+ 'framed_pool' => 'Framed-Pool',
+ 'usr_igmp_version' => 'USR-IGMP-Version',
+ 'tunnel_max_tunnels' => 'Tunnel_Max_Tunnels',
+ 'annex_unauthenticated_ti' => 'Annex-Unauthenticated-Time',
+ 'bg_path_cost' => 'BG_Path_Cost',
+ 'ascend_client_assign_win' => 'Ascend-Client-Assign-WINS',
+ 'x_ascend_dial_number' => 'X-Ascend-Dial-Number',
+ 'cisco_maximum_channels' => 'Cisco-Maximum-Channels',
+ 'usr_pw_framed_routing_v2' => 'USR-PW_Framed_Routing_V2',
+ 'usr_channel_decrement' => 'USR-Channel-Decrement',
+ 'x_ascend_route_ipx' => 'X-Ascend-Route-IPX',
+ 'port_limit' => 'Port-Limit',
+ 'ascend_dsl_downstream_li' => 'Ascend-Dsl-Downstream-Limit',
+ 'ascend_ip_tos_precedence' => 'Ascend-IP-TOS-Precedence',
+ 'usr_multicast_receive' => 'USR-Multicast-Receive',
+ 'usr_auth_mode' => 'USR-Auth-Mode',
+ 'expiration' => 'Expiration',
+ 'x_ascend_fr_circuit_name' => 'X-Ascend-FR-Circuit-Name',
+ 'x_ascend_token_immediate' => 'X-Ascend-Token-Immediate',
+ 'ascend_ft1_caller' => 'Ascend-FT1-Caller',
+ 'shiva_event_flags' => 'Shiva-Event-Flags',
+ 'framed_netmask' => 'Framed-Netmask',
+ 'ascend_minimum_channels' => 'Ascend-Minimum-Channels',
+ 'acc_ml_damping_factor' => 'Acc-ML-Damping-Factor',
+ 'bind_sub_password' => 'Bind_Sub_Password',
+ 'ascend_ip_tos_apply_to' => 'Ascend-IP-TOS-Apply-To',
+ 'x_ascend_home_agent_udp_' => 'X-Ascend-Home-Agent-UDP-Port',
+ 'x_ascend_menu_item' => 'X-Ascend-Menu-Item',
+ 'ascend_session_type' => 'Ascend-Session-Type',
+ 'usr_pw_packet' => 'USR-PW_Packet',
+ 'session' => 'Session',
+ 'usr_mic' => 'USR-MIC',
+ 'usr_line_reversals' => 'USR-Line-Reversals',
+ 'assigned_ip_address' => 'Assigned_IP_Address',
+ 'cisco_ip_direct' => 'Cisco-IP-Direct',
+ 'le_ipsec_log_options' => 'LE-IPSec-Log-Options',
+ 'tunnel_rate_limit_burst' => 'Tunnel_Rate_Limit_Burst',
+ 'x_ascend_assign_ip_globa' => 'X-Ascend-Assign-IP-Global-Pool',
+ 'x_ascend_inc_channel_cou' => 'X-Ascend-Inc-Channel-Count',
+ 'h323_return_code' => 'h323-return-code',
+ 'shiva_disconnect_reason' => 'Shiva-Disconnect-Reason',
+ 'filter_id' => 'Filter-Id',
+ 'usr_appletalk_network_ra' => 'USR-Appletalk-Network-Range',
+ 'ascend_temporary_rtes' => 'Ascend-Temporary-Rtes',
+ 'ascend_h323_conference_i' => 'Ascend-H323-Conference-Id',
+ 'h323_billing_model' => 'h323-billing-model',
+ 'usr_bearer_capabilities' => 'USR-Bearer-Capabilities',
+ 'framed_appletalk_zone' => 'Framed-AppleTalk-Zone',
+ 'usr_harc_disconnect_code' => 'USR-HARC-Disconnect-Code',
+ 'usr_ipx_rip_input_filter' => 'USR-IPX-RIP-Input-Filter',
+ 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Bound',
+ 'ascend_pw_lifetime' => 'Ascend-PW-Lifetime',
+ 'acc_dialout_auth_usernam' => 'Acc-Dialout-Auth-Username',
+ 'ascend_x25_pad_x3_parame' => 'Ascend-X25-Pad-X3-Parameters',
+ 'bind_dot1q_slot' => 'Bind_Dot1q_Slot',
+ 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-RtLim',
+ 'x_ascend_multicast_clien' => 'X-Ascend-Multicast-Client',
+ 'ascend_authen_alias' => 'Ascend-Authen-Alias',
+ 'ascend_dec_channel_count' => 'Ascend-Dec-Channel-Count',
+ 'dhcp_max_leases' => 'DHCP_Max_Leases',
+ 'shiva_called_number' => 'Shiva-Called-Number',
+ 'annex_tunnel_authen_mode' => 'Annex-Tunnel-Authen-Mode',
+ 'usr_call_error_code' => 'USR-Call-Error-Code',
+ 'x_ascend_user_acct_type' => 'X-Ascend-User-Acct-Type',
+ 'ascend_atm_connect_vpi' => 'Ascend-ATM-Connect-Vpi',
+ 'ascend_x25_pad_x3_profil' => 'Ascend-X25-Pad-X3-Profile',
+ 'usr_mobileip_home_agent_' => 'USR-MobileIP-Home-Agent-Address',
+ 'suffix' => 'Suffix',
+ 'bind_tun_context' => 'Bind_Tun_Context',
+ 'x_ascend_ppp_address' => 'X-Ascend-PPP-Address',
+ 'usr_dtr_false_timeout' => 'USR-DTR-False-Timeout',
+ 'usr_final_rx_link_data_r' => 'USR-Final-Rx-Link-Data-Rate',
+ 'ms_chap_error' => 'MS-CHAP-Error',
+ 'x_ascend_home_agent_ip_a' => 'X-Ascend-Home-Agent-IP-Addr',
+ 'ascend_data_svc' => 'Ascend-Data-Svc',
+ 'usr_rmmie_pwrlvl_noise_l' => 'USR-RMMIE-PwrLvl-Noise-Lvl',
+ 'usr_dtr_true_timeout' => 'USR-DTR-True-Timeout',
+ 'context_name' => 'Context-Name',
+ 'usr_card_type' => 'USR-Card-Type',
+ 'ascend_fr_link_status_dl' => 'Ascend-FR-Link-Status-DLCI',
+ 'annex_sec_profile_index' => 'Annex-Sec-Profile-Index',
+ 'usr_pw_usr_ofilter_sap' => 'USR-PW_USR_OFilter_SAP',
+ 'tunnel_medium_type' => 'Tunnel-Medium-Type',
+ 'x_ascend_require_auth' => 'X-Ascend-Require-Auth',
+ 'ascend_connect_progress' => 'Ascend-Connect-Progress',
+ 'x_ascend_modem_shelfno' => 'X-Ascend-Modem-ShelfNo',
+ 'cisco_pre_input_packets' => 'Cisco-Pre-Input-Packets',
+ 'ascend_fr_dce_n392' => 'Ascend-FR-DCE-N392',
+ 'ascend_fr_dce_n393' => 'Ascend-FR-DCE-N393',
+ 'ascend_client_primary_wi' => 'Ascend-Client-Primary-WINS',
+ 'shiva_link_protocol' => 'Shiva-Link-Protocol',
+ 'bridge_group' => 'Bridge_Group',
+ 'client_port_dnis' => 'Client-Port-DNIS',
+ 'usr_mpip_tunnel_originat' => 'USR-MPIP-Tunnel-Originator',
+ 'le_nat_log_options' => 'LE-NAT-Log-Options',
+ 'usr_number_of_rings_limi' => 'USR-Number-of-Rings-Limit',
+ 'usr_retrains_granted' => 'USR-Retrains-Granted',
+ 'acc_ip_gateway_pri' => 'Acc-Ip-Gateway-Pri',
+ 'usr_number_of_fallbacks' => 'USR-Number-of-Fallbacks',
+ 'usr_tunnel_auth_hostname' => 'USR-Tunnel-Auth-Hostname',
+ 'annex_filter' => 'Annex-Filter',
+ 'ascend_mtu' => 'Ascend-MTU',
+ 'ms_arap_pw_change_reason' => 'MS-ARAP-PW-Change-Reason',
+ 'private_group_id' => 'Private-Group-Id',
+ 'ascend_cache_time' => 'Ascend-Cache-Time',
+ 'acc_ml_clear_threshold' => 'Acc-ML-Clear-Threshold',
+ 'x_ascend_dhcp_reply' => 'X-Ascend-DHCP-Reply',
+ 'ascend_h323_gatekeeper' => 'Ascend-H323-Gatekeeper',
+ 'x_ascend_xmit_rate' => 'X-Ascend-Xmit-Rate',
+ 'usr_last_number_dialed_o' => 'USR-Last-Number-Dialed-Out',
+ 'acc_connect_rx_speed' => 'Acc-Connect-Rx-Speed',
+ 'acc_clearing_cause' => 'Acc-Clearing-Cause',
+ 'ascend_call_attempt_limi' => 'Ascend-Call-Attempt-Limit',
+ 'x_ascend_data_rate' => 'X-Ascend-Data-Rate',
+ 'termination_action' => 'Termination-Action',
+ 'ascend_pre_input_octets' => 'Ascend-Pre-Input-Octets',
+ 'x_ascend_ipx_route' => 'X-Ascend-IPX-Route',
+ 'x_ascend_ts_idle_mode' => 'X-Ascend-TS-Idle-Mode',
+ 'client_ip_address' => 'Client-IP-Address',
+ 'ascend_add_seconds' => 'Ascend-Add-Seconds',
+ 'login_ip_host' => 'Login-IP-Host',
+ 'annex_sw_version' => 'Annex-SW-Version',
+ 'huntgroup_name' => 'Huntgroup-Name',
+ 'usr_pw_vpn_gateway' => 'USR-PW_VPN_Gateway',
+ 'ascend_x25_reverse_charg' => 'Ascend-X25-Reverse-Charging',
+ 'lac_real_port' => 'LAC_Real_Port',
+ 'ascend_dba_monitor' => 'Ascend-DBA-Monitor',
+ 'annex_user_server_locati' => 'Annex-User-Server-Location',
+ 'ascend_h323_fegw_address' => 'Ascend-H323-Fegw-Address',
+ 'acct_output_gigawords' => 'Acct-Output-Gigawords',
+ 'bind_l2tp_tunnel_name' => 'Bind_L2TP_Tunnel_Name',
+ 'x_ascend_token_idle' => 'X-Ascend-Token-Idle',
+ 'acc_apsm_oversubscribed' => 'Acc-Apsm-Oversubscribed',
+ 'ip_tos_field' => 'IP_TOS_Field',
+ 'ascend_dsl_cir_xmit_limi' => 'Ascend-Dsl-CIR-Xmit-Limit',
+ 'usr_number_of_link_naks' => 'USR-Number-of-Link-NAKs',
+ 'framed_address' => 'Framed-Address',
+ 'x_ascend_num_in_multilin' => 'X-Ascend-Num-In-Multilink',
+ 'hint' => 'Hint',
+ 'ascend_source_ip_check' => 'Ascend-Source-IP-Check',
+ 'arap_zone_access' => 'ARAP-Zone-Access',
+ 'x_ascend_fr_direct_profi' => 'X-Ascend-FR-Direct-Profile',
+ 'x_ascend_bridge_address' => 'X-Ascend-Bridge-Address',
+ 'usr_iwf_call_identifier' => 'USR-IWF-Call-Identifier',
+ 'ascend_home_network_name' => 'Ascend-Home-Network-Name',
+ 'ascend_require_auth' => 'Ascend-Require-Auth',
+ 'source_validation' => 'Source_Validation',
+ 'ms_primary_nbns_server' => 'MS-Primary-NBNS-Server',
+ 'h323_setup_time' => 'h323-setup-time',
+ 'tunnel_remote_name' => 'Tunnel_Remote_Name',
+ 'ascend_maximum_channels' => 'Ascend-Maximum-Channels',
+ 'ascend_tunneling_protoco' => 'Ascend-Tunneling-Protocol',
+ 'arap_security_data' => 'ARAP-Security-Data',
+ 'ascend_ipx_peer_mode' => 'Ascend-IPX-Peer-Mode',
+ 'ascend_cir_timer' => 'Ascend-CIR-Timer',
+ 'ascend_ts_idle_limit' => 'Ascend-TS-Idle-Limit',
+ 'ascend_cache_refresh' => 'Ascend-Cache-Refresh',
+ 'usr_rmmie_status' => 'USR-RMMIE-Status',
+ 'annex_callback_portlist' => 'Annex-Callback-Portlist',
+ 'usr_port_tap' => 'USR-Port-Tap',
+ 'ascend_client_secondary_' => 'Ascend-Client-Secondary-DNS',
+ 'x_ascend_first_dest' => 'X-Ascend-First-Dest',
+ 'lac_port' => 'LAC_Port',
+ 'acc_callback_cbcp_type' => 'Acc-Callback-CBCP-Type',
+ 'usr_call_reference_numbe' => 'USR-Call-Reference-Number',
+ 'mcast_receive' => 'Mcast_Receive',
+ 'x_ascend_link_compressio' => 'X-Ascend-Link-Compression',
+ 'ascend_inter_arrival_jit' => 'Ascend-Inter-Arrival-Jitter',
+ 'x_ascend_assign_ip_pool' => 'X-Ascend-Assign-IP-Pool',
+ 'usr_chassis_call_span' => 'USR-Chassis-Call-Span',
+ 'arap_password' => 'ARAP-Password',
+ 'usr_ip_default_route_opt' => 'USR-IP-Default-Route-Option',
+ 'ascend_endpoint_disc' => 'Ascend-Endpoint-Disc',
+ 'tunnel_dnis' => 'Tunnel_DNIS',
+ 'ms_acct_auth_type' => 'MS-Acct-Auth-Type',
+ 'ascend_ts_idle_mode' => 'Ascend-TS-Idle-Mode',
+ 'shasta_service_profile' => 'Shasta-Service-Profile',
+ 'usr_cdma_call_reference_' => 'USR-CDMA-Call-Reference-Number',
+ 'usr_at_zip_input_filter' => 'USR-AT-Zip-Input-Filter',
+ 'x_ascend_pw_warntime' => 'X-Ascend-PW-Warntime',
+ 'ascend_fr_direct_dlci' => 'Ascend-FR-Direct-DLCI',
+ 'usr_dte_ring_no_answer_l' => 'USR-DTE-Ring-No-Answer-Limit',
+ 'ascend_multicast_rate_li' => 'Ascend-Multicast-Rate-Limit',
+ 'usr_routing_protocol' => 'USR-Routing-Protocol',
+ 'pam_auth' => 'Pam-Auth',
+ 'client_dns_sec' => 'Client_DNS_Sec',
+ 'bg_trans_bpdu' => 'BG_Trans_BPDU',
+ 'police_rate' => 'Police_Rate',
+ 'calling_station_id' => 'Calling-Station-Id',
+ 'usr_called_party_number' => 'USR-Called-Party-Number',
+ 'shiva_network_protocols' => 'Shiva-Network-Protocols',
+ 'x_ascend_client_gateway' => 'X-Ascend-Client-Gateway',
+ 'acct_input_octets' => 'Acct-Input-Octets',
+ 'ascend_call_type' => 'Ascend-Call-Type',
+ 'annex_product_name' => 'Annex-Product-Name',
+ 'framed_compression' => 'Framed-Compression',
+ 'ascend_atm_direct' => 'Ascend-ATM-Direct',
+ 'x_ascend_remote_addr' => 'X-Ascend-Remote-Addr',
+ 'usr_tunneled_mlpp' => 'USR-Tunneled-MLPP',
+ 'le_ipsec_outsource_profi' => 'LE-IPSec-Outsource-Profile',
+ 'ascend_atm_vci' => 'Ascend-ATM-Vci',
+ 'usr_number_of_link_timeo' => 'USR-Number-of-Link-Timeouts',
+ 'usr_et_bridge_input_filt' => 'USR-ET-Bridge-Input-Filter',
+ 'x_ascend_fr_t391' => 'X-Ascend-FR-T391',
+ 'x_ascend_fr_t392' => 'X-Ascend-FR-T392',
+ 'h323_conf_id' => 'h323-conf-id',
+ 'usr_call_end_date_time' => 'USR-Call-End-Date-Time',
+ 'ascend_fr_t391' => 'Ascend-FR-T391',
+ 'bg_aging_time' => 'BG_Aging_Time',
+ 'x_ascend_pre_output_pack' => 'X-Ascend-Pre-Output-Packets',
+ 'acc_dialout_auth_mode' => 'Acc-Dialout-Auth-Mode',
+ 'ascend_calling_subaddres' => 'Ascend-Calling-Subaddress',
+ 'ascend_fr_t392' => 'Ascend-FR-T392',
+ 'acct_link_count' => 'Acct-Link-Count',
+ 'usr_chassis_call_slot' => 'USR-Chassis-Call-Slot',
+ 'h323_credit_time' => 'h323-credit-time',
+ 'nas_port_id' => 'NAS-Port-Id',
+ 'x_ascend_call_filter' => 'X-Ascend-Call-Filter',
+ 'ascend_destination_nas_p' => 'Ascend-Destination-Nas-Port',
+ 'arap_features' => 'ARAP-Features',
+ 'x_ascend_history_weigh_t' => 'X-Ascend-History-Weigh-Type',
+ 'annex_host_restrict' => 'Annex-Host-Restrict',
+ 'usr_compression_reset_mo' => 'USR-Compression-Reset-Mode',
+ 'cisco_maximum_time' => 'Cisco-Maximum-Time',
+ 'tunnel_max_sessions' => 'Tunnel_Max_Sessions',
+ 'bind_ses_context' => 'Bind_Ses_Context',
+ 'x_ascend_ppp_vj_slot_com' => 'X-Ascend-PPP-VJ-Slot-Comp',
+ 'usr_mobile_numbytes_rxed' => 'USR-Mobile-NumBytes-Rxed',
+ 'usr_rmmie_last_update_ti' => 'USR-RMMIE-Last-Update-Time',
+ 'ascend_atm_loopback_cell' => 'Ascend-ATM-Loopback-Cell-Loss',
+ 'ascend_bir_proxy' => 'Ascend-BIR-Proxy',
+ 'acct_mcast_in_packets' => 'Acct_Mcast_In_Packets',
+ 'shiva_type_of_service' => 'Shiva-Type-Of-Service',
+ 'ascend_fr_dte_n392' => 'Ascend-FR-DTE-N392',
+ 'usr_at_call_input_filter' => 'USR-AT-Call-Input-Filter',
+ 'ascend_fr_dte_n393' => 'Ascend-FR-DTE-N393',
+ 'x_ascend_backup' => 'X-Ascend-Backup',
+ 'char_noecho' => 'Char-Noecho',
+ 'usr_rmmie_last_update_ev' => 'USR-RMMIE-Last-Update-Event',
+ 'le_advice_of_charge' => 'LE-Advice-of-Charge',
+ 'ascend_calling_id_type_o' => 'Ascend-Calling-Id-Type-Of-Num',
+ 'ascend_pppoe_enable' => 'Ascend-PPPoE-Enable',
+ 'usr_sync_async_mode' => 'USR-Sync-Async-Mode',
+ 'state' => 'State',
+ 'x_ascend_user_acct_base' => 'X-Ascend-User-Acct-Base',
+ 'x_ascend_ipx_alias' => 'X-Ascend-IPX-Alias',
+ 'ascend_ip_tos' => 'Ascend-IP-TOS',
+ 'annex_secondary_dns_serv' => 'Annex-Secondary-DNS-Server',
+ 'tunnel_session_auth_ctx' => 'Tunnel_Session_Auth_Ctx',
+ 'usr_mbi_ct_pri_card_span' => 'USR-Mbi_Ct_PRI_Card_Span_Line',
+ 'usr_call_event_code' => 'USR-Call-Event-Code',
+ 'chap_password' => 'CHAP-Password',
+ 'le_nat_tcp_session_timeo' => 'LE-NAT-TCP-Session-Timeout',
+ 'usr_call_start_date_time' => 'USR-Call-Start-Date-Time',
+ 'usr_multicast_forwarding' => 'USR-Multicast-Forwarding',
+ 'client_id' => 'Client-Id',
+ 'sql_user_name' => 'SQL-User-Name',
+ 'x_ascend_billing_number' => 'X-Ascend-Billing-Number',
+ 'ms_secondary_nbns_server' => 'MS-Secondary-NBNS-Server',
+ 'cisco_num_in_multilink' => 'Cisco-Num-In-Multilink',
+ 'x_ascend_client_assign_d' => 'X-Ascend-Client-Assign-DNS',
+ 'x_ascend_user_acct_port' => 'X-Ascend-User-Acct-Port',
+ 'usr_local_ip_address' => 'USR-Local-IP-Address',
+ 'x_ascend_ip_pool_definit' => 'X-Ascend-IP-Pool-Definition',
+ 'ascend_metric' => 'Ascend-Metric',
+ 'x_ascend_bacp_enable' => 'X-Ascend-BACP-Enable',
+ 'x_ascend_user_acct_time' => 'X-Ascend-User-Acct-Time',
+ 'x_ascend_mpp_idle_percen' => 'X-Ascend-MPP-Idle-Percent',
+ 'annex_authen_servers' => 'Annex-Authen-Servers',
+ 'x_ascend_data_filter' => 'X-Ascend-Data-Filter',
+ 'ascend_idle_limit' => 'Ascend-Idle-Limit',
+ 'ldap_userdn' => 'Ldap-UserDn',
+ 'x_ascend_target_util' => 'X-Ascend-Target-Util',
+ 'shiva_connect_reason' => 'Shiva-Connect-Reason',
+ 'usr_ds0' => 'USR-DS0',
+ 'annex_re_chap_timeout' => 'Annex-Re-CHAP-Timeout',
+ 'shasta_vpn_name' => 'Shasta-VPN-Name',
+ 'acct_tunnel_connection_i' => 'Acct-Tunnel-Connection-Id',
+ 'h323_prompt_id' => 'h323-prompt-id',
+ 'x_ascend_ipx_peer_mode' => 'X-Ascend-IPX-Peer-Mode',
+ 'ascend_numbering_plan_id' => 'Ascend-Numbering-Plan-ID',
+ 'x_ascend_ts_idle_limit' => 'X-Ascend-TS-Idle-Limit',
+ 'ascend_atm_fault_managem' => 'Ascend-ATM-Fault-Management',
+ 'annex_primary_nbns_serve' => 'Annex-Primary-NBNS-Server',
+ 'lac_port_type' => 'LAC_Port_Type',
+ 'usr_initial_rx_link_data' => 'USR-Initial-Rx-Link-Data-Rate',
+ 'usr_interface_index' => 'USR-Interface-Index',
+ 'usr_expansion_algorithm' => 'USR-Expansion-Algorithm',
+ 'ascend_tunnel_vrouter_na' => 'Ascend-Tunnel-VRouter-Name',
+ 'usr_pw_vpn_neighbor' => 'USR-PW_VPN_Neighbor',
+ 'bind_type' => 'Bind_Type',
+ 'acc_ccp_option' => 'Acc-Ccp-Option',
+ 'ascend_route_appletalk' => 'Ascend-Route-Appletalk',
+ 'erx_alternate_cli_access' => 'ERX-Alternate-Cli-Access-Level',
+ 'usr_at_rtmp_output_filte' => 'USR-AT-RTMP-Output-Filter',
+ 'erx_atm_mbs' => 'ERX-Atm-MBS',
+ 'usr_at_call_output_filte' => 'USR-AT-Call-Output-Filter',
+ 'ms_old_arap_password' => 'MS-Old-ARAP-Password',
+ 'x_ascend_client_primary_' => 'X-Ascend-Client-Primary-DNS',
+ 'x_ascend_host_info' => 'X-Ascend-Host-Info',
+ 'bind_auth_protocol' => 'Bind_Auth_Protocol',
+ 'cisco_link_compression' => 'Cisco-Link-Compression',
+ 'annex_syslog_tap' => 'Annex-Syslog-Tap',
+ 'tunnel_window' => 'Tunnel_Window',
+ 'usr_gateway_ip_address' => 'USR-Gateway-IP-Address',
+ 'ascend_redirect_number' => 'Ascend-Redirect-Number',
+ 'x_ascend_secondary_home_' => 'X-Ascend-Secondary-Home-Agent',
+ 'usr_pw_index' => 'USR-PW_Index',
+ 'le_multicast_client' => 'LE-Multicast-Client',
+ 'annex_modem_disc_reason' => 'Annex-Modem-Disc-Reason',
+ 'annex_primary_dns_server' => 'Annex-Primary-DNS-Server',
+ 'erx_secondary_wins' => 'ERX-Secondary-Wins',
+ 'fall_through' => 'Fall-Through',
+ 'acct_mcast_out_packets' => 'Acct_Mcast_Out_Packets',
+ 'x_ascend_transit_number' => 'X-Ascend-Transit-Number',
+ 'usr_unauthenticated_time' => 'USR-Unauthenticated-Time',
+ 'le_ipsec_active_profile' => 'LE-IPSec-Active-Profile',
+ 'ascend_ip_pool_chaining' => 'Ascend-IP-Pool-Chaining',
+ 'usr_syslog_tap' => 'USR-Syslog-Tap',
+ 'ascend_multicast_client' => 'Ascend-Multicast-Client',
+ 'usr_device_connected_to' => 'USR-Device-Connected-To',
+ 'tunnel_l2f_second_passwo' => 'Tunnel_L2F_Second_Password',
+ 'add_prefix' => 'Add-Prefix',
+ 'tunnel_cmd_timeout' => 'Tunnel_Cmd_Timeout',
+ 'x_ascend_remove_seconds' => 'X-Ascend-Remove-Seconds',
+ 'acct_mcast_in_octets' => 'Acct_Mcast_In_Octets',
+ 'ascend_appletalk_route' => 'Ascend-Appletalk-Route',
+ 'ascend_fcp_parameter' => 'Ascend-FCP-Parameter',
+ 'acc_ip_compression' => 'Acc-Ip-Compression',
+ 'usr_modem_training_time' => 'USR-Modem-Training-Time',
+ 'usr_primary_dns_server' => 'USR-Primary_DNS_Server',
+ 'erx_egress_policy_name' => 'ERX-Egress-Policy-Name',
+ 'x_ascend_base_channel_co' => 'X-Ascend-Base-Channel-Count',
+ 'x_ascend_pre_input_packe' => 'X-Ascend-Pre-Input-Packets',
+ 'password_retry' => 'Password-Retry',
+ 'ascend_source_auth' => 'Ascend-Source-Auth',
+ 'cisco_pw_lifetime' => 'Cisco-PW-Lifetime',
+ 'acc_dns_server_pri' => 'Acc-Dns-Server-Pri',
+ 'ascend_netware_timeout' => 'Ascend-Netware-timeout',
+ 'ascend_ppp_async_map' => 'Ascend-PPP-Async-Map',
+ 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Ttl',
+ 'x_ascend_modem_slotno' => 'X-Ascend-Modem-SlotNo',
+ 'x_ascend_ip_direct' => 'X-Ascend-IP-Direct',
+ 'simultaneous_use' => 'Simultaneous-Use',
+ 'erx_virtual_router_name' => 'ERX-Virtual-Router-Name',
+ 'ascend_bridge_non_pppoe' => 'Ascend-Bridge-Non-PPPoE',
+ 'ascend_fr_08_mode' => 'Ascend-FR-08-Mode',
+ 'h323_call_type' => 'h323-call-type',
+ 'tunnel_context' => 'Tunnel_Context',
+ 'usr_transmit_acc_map' => 'USR-Transmit-Acc-Map',
+ 'usr_ipx_wan' => 'USR-IPX-WAN',
+ 'usr_ip_call_input_filter' => 'USR-IP-Call-Input-Filter',
+ 'usr_call_connect_in_gmt' => 'USR-Call-Connect-in-GMT',
+ 'acct_multi_session_id' => 'Acct-Multi-Session-Id',
+ 'usr_reply_script1' => 'USR-Reply-Script1',
+ 'cisco_ppp_vj_slot_comp' => 'Cisco-PPP-VJ-Slot-Comp',
+ 'usr_reply_script2' => 'USR-Reply-Script2',
+ 'usr_reply_script3' => 'USR-Reply-Script3',
+ 'usr_reply_script4' => 'USR-Reply-Script4',
+ 'usr_reply_script5' => 'USR-Reply-Script5',
+ 'usr_reply_script6' => 'USR-Reply-Script6',
+ 'user_category' => 'User-Category',
+ 'mcast_send' => 'Mcast_Send',
+ 'ascend_send_secret' => 'Ascend-Send-Secret',
+ 'usr_tunnel_switch_endpoi' => 'USR-Tunnel-Switch-Endpoint',
+ 'tunnel_retransmit' => 'Tunnel_Retransmit',
+ 'add_port_to_ip_address' => 'Add-Port-To-IP-Address',
+ 'ascend_ipx_node_addr' => 'Ascend-IPX-Node-Addr',
+ 'x_ascend_netware_timeout' => 'X-Ascend-Netware-timeout',
+ 'erx_sa_validate' => 'ERX-Sa-Validate',
+ 'le_ipsec_passive_profile' => 'LE-IPSec-Passive-Profile',
+ 'usr_chassis_slot' => 'USR-Chassis-Slot',
+ 'usr_final_tx_link_data_r' => 'USR-Final-Tx-Link-Data-Rate',
+ 'usr_nfas_id' => 'USR-NFAS-ID',
+ 'called_station_id' => 'Called-Station-Id',
+ 'login_lat_port' => 'Login-LAT-Port',
+ 'ascend_dialed_number' => 'Ascend-Dialed-Number',
+ 'h323_credit_amount' => 'h323-credit-amount',
+ 'tunnel_local_name' => 'Tunnel_Local_Name',
+ 'framed_ip_netmask' => 'Framed-IP-Netmask',
+ 'client_port_id' => 'Client-Port-Id',
+ 'bg_span_dis' => 'BG_Span_Dis',
+ 'multi_link_flag' => 'Multi-Link-Flag',
+ 'bind_sub_user_at_context' => 'Bind_Sub_User_At_Context',
+ 'usr_ipx_routing' => 'USR-IPX-Routing',
+ 'ascend_fr_nailed_grp' => 'Ascend-FR-Nailed-Grp',
+ 'ascend_pre_output_octets' => 'Ascend-Pre-Output-Octets',
+ 'pppoe_url' => 'PPPOE_URL',
+ 'ascend_ara_pw' => 'Ascend-Ara-PW',
+ 'acc_callback_mode' => 'Acc-Callback-Mode',
+ 'usr_server_time' => 'USR-Server-Time',
+ 'ascend_seconds_of_histor' => 'Ascend-Seconds-Of-History',
+ 'ns_mta_md5_password' => 'NS-MTA-MD5-Password',
+ 'tunnel_server_endpoint' => 'Tunnel-Server-Endpoint',
+ 'usr_channel' => 'USR-Channel',
+ 'ascend_dsl_cir_recv_limi' => 'Ascend-Dsl-CIR-Recv-Limit',
+ 'acct_session_start_time' => 'Acct-Session-Start-Time',
+ 'ascend_send_passwd' => 'Ascend-Send-Passwd',
+ 'ascend_num_in_multilink' => 'Ascend-Num-In-Multilink',
+ 'usr_ip_rip_policies' => 'USR-IP-RIP-Policies',
+ 'vendor_specific' => 'Vendor-Specific',
+ 'x_ascend_event_type' => 'X-Ascend-Event-Type',
+ 'lac_real_port_type' => 'LAC_Real_Port_Type',
+ 'x_ascend_modem_portno' => 'X-Ascend-Modem-PortNo',
+ 'usr_originate_answer_mod' => 'USR-Originate-Answer-Mode',
+ 'framed_ipx_network' => 'Framed-IPX-Network',
+ 'ascend_modem_slotno' => 'Ascend-Modem-SlotNo',
+ 'ms_mppe_encryption_type' => 'MS-MPPE-Encryption-Type',
+ 'annex_cli_command' => 'Annex-CLI-Command',
+ 'acct_status_type' => 'Acct-Status-Type',
+ 'usr_et_bridge_call_outpu' => 'USR-ET-Bridge-Call-Output-Filte',
+ 'usr_pw_vpn_id' => 'USR-PW_VPN_ID',
+ 'usr_sap_filter_in' => 'USR-SAP-Filter-In',
+ 'usr_rad_multicast_routin' => 'USR-Rad-Multicast-Routing-Proto',
+ 'annex_audit_level' => 'Annex-Audit-Level',
+ 'x_ascend_shared_profile_' => 'X-Ascend-Shared-Profile-Enable',
+ 'ascend_dial_number' => 'Ascend-Dial-Number',
+ 'ascend_link_compression' => 'Ascend-Link-Compression',
+ 'usr_event_date_time' => 'USR-Event-Date-Time',
+ 'usr_mp_edo_hiper' => 'USR-MP-EDO-HIPER',
+ 'usr_re_chap_timeout' => 'USR-Re-Chap-Timeout',
+ 'x_ascend_third_prompt' => 'X-Ascend-Third-Prompt',
+ 'x_ascend_ppp_vj_1172' => 'X-Ascend-PPP-VJ-1172',
+ 'annex_disconnect_reason' => 'Annex-Disconnect-Reason',
+ 'ascend_fr_svc_addr' => 'Ascend-FR-SVC-Addr',
+ 'nas_real_port' => 'NAS_Real_Port',
+ 'usr_power_supply_number' => 'USR-Power-Supply-Number',
+ 'ms_secondary_dns_server' => 'MS-Secondary-DNS-Server',
+ 'ascend_port_redir_server' => 'Ascend-Port-Redir-Server',
+ 'ascend_x25_pad_alias_1' => 'Ascend-X25-Pad-Alias-1',
+ 'x_ascend_fcp_parameter' => 'X-Ascend-FCP-Parameter',
+ 'ascend_x25_pad_alias_2' => 'Ascend-X25-Pad-Alias-2',
+ 'ascend_ipsec_profile' => 'Ascend-IPSEC-Profile',
+ 'ascend_x25_pad_alias_3' => 'Ascend-X25-Pad-Alias-3',
+ 'usr_mobile_numbytes_txed' => 'USR-Mobile-NumBytes-Txed',
+ 'ascend_atm_vpi' => 'Ascend-ATM-Vpi',
+ 'annex_input_filter' => 'Annex-Input-Filter',
+ 'menu' => 'Menu',
+ 'x_ascend_route_ip' => 'X-Ascend-Route-IP',
+ 'usr_rmmie_num_of_updates' => 'USR-RMMIE-Num-Of-Updates',
+ 'acc_request_type' => 'Acc-Request-Type',
+ 'ascend_dhcp_reply' => 'Ascend-DHCP-Reply',
+ 'usr_number_of_upshifts' => 'USR-Number-of-Upshifts',
+ 'usr_rmmie_firmware_versi' => 'USR-RMMIE-Firmware-Version',
+ 'bind_bypass_context' => 'Bind_Bypass_Context',
+ 'ascend_dialout_allowed' => 'Ascend-Dialout-Allowed',
+ 'annex_tunnel_authen_type' => 'Annex-Tunnel-Authen-Type',
+ 'x_ascend_bridge' => 'X-Ascend-Bridge',
+ 'ascend_client_secondary_' => 'Ascend-Client-Secondary-WINS',
+ 'erx_local_loopback_inter' => 'ERX-Local-Loopback-Interface',
+ 'acct_input_gigawords' => 'Acct-Input-Gigawords',
+ 'usr_equalization_type' => 'USR-Equalization-Type',
+ 'usr_port_tap_format' => 'USR-Port-Tap-Format',
+ 'x_ascend_ppp_async_map' => 'X-Ascend-PPP-Async-Map',
+ 'acc_ipx_compression' => 'Acc-Ipx-Compression',
+ 'ascend_nas_port_format' => 'Ascend-NAS-Port-Format',
+ 'acc_modem_modulation_typ' => 'Acc-Modem-Modulation-Type',
+ 'ascend_modem_portno' => 'Ascend-Modem-PortNo',
+ 'usr_et_bridge_output_fil' => 'USR-ET-Bridge-Output-Filter',
+ 'ascend_ipx_header_compre' => 'Ascend-IPX-Header-Compression',
+ 'framed_appletalk_link' => 'Framed-AppleTalk-Link',
+ 'x_ascend_receive_secret' => 'X-Ascend-Receive-Secret',
+ 'ascend_route_ipx' => 'Ascend-Route-IPX',
+ 'ascend_user_acct_type' => 'Ascend-User-Acct-Type',
+ 'ascend_token_idle' => 'Ascend-Token-Idle',
+ 'framed_ip_address' => 'Framed-IP-Address',
+ 'ascend_call_block_durati' => 'Ascend-Call-Block-Duration',
+ 'ascend_ppp_address' => 'Ascend-PPP-Address',
+ 'usr_mbi_ct_pri_card_slot' => 'USR-Mbi_Ct_PRI_Card_Slot',
+ 'x_ascend_dec_channel_cou' => 'X-Ascend-Dec-Channel-Count',
+ 'x_ascend_send_auth' => 'X-Ascend-Send-Auth',
+ 'usr_characters_received' => 'USR-Characters-Received',
+ 'usr_pw_tunnel_authentica' => 'USR-PW_Tunnel_Authentication',
+ 'usr_call_end_time' => 'USR-Call-End-Time',
+ 'x_ascend_dialout_allowed' => 'X-Ascend-Dialout-Allowed',
+ 'x_ascend_call_attempt_li' => 'X-Ascend-Call-Attempt-Limit',
+ 'initial_modulation_type' => 'Initial-Modulation-Type',
+ 'usr_packet_bus_session' => 'USR-Packet-Bus-Session',
+ 'x_ascend_ipx_node_addr' => 'X-Ascend-IPX-Node-Addr',
+ 'ascend_ppp_vj_slot_comp' => 'Ascend-PPP-VJ-Slot-Comp',
+ 'ascend_menu_item' => 'Ascend-Menu-Item',
+ 'x_ascend_fr_link_mgt' => 'X-Ascend-FR-Link-Mgt',
+ 'usr_rmmie_serial_number' => 'USR-RMMIE-Serial-Number',
+ 'message_authenticator' => 'Message-Authenticator',
+ 'usr_dte_data_idle_timout' => 'USR-DTE-Data-Idle-Timout',
+ 'usr_port_tap_facility' => 'USR-Port-Tap-Facility',
+ 'acc_ml_mlx_admin_state' => 'Acc-ML-MLX-Admin-State',
+ 'usr_modem_group' => 'USR-Modem-Group',
+ 'x_ascend_callback' => 'X-Ascend-Callback',
+ 'acct_input_packets_64' => 'Acct_Input_Packets_64',
+ 'ascend_third_prompt' => 'Ascend-Third-Prompt',
+ 'configuration_token' => 'Configuration-Token',
+ 'x_ascend_fr_nailed_grp' => 'X-Ascend-FR-Nailed-Grp',
+ 'acct_output_octets_64' => 'Acct_Output_Octets_64',
+ 'h323_time_and_day' => 'h323-time-and-day',
+ 'ascend_port_redir_portnu' => 'Ascend-Port-Redir-Portnum',
+ 'acct_interim_interval' => 'Acct-Interim-Interval',
+ 'ascend_uu_info' => 'Ascend-UU-Info',
+ 'usr_pw_vpn_name' => 'USR-PW_VPN_Name',
+ 'ascend_maximum_call_dura' => 'Ascend-Maximum-Call-Duration',
+ 'ascend_atm_direct_profil' => 'Ascend-ATM-Direct-Profile',
+ 'acc_input_errors' => 'Acc-Input-Errors',
+ 'bind_dot1q_port' => 'Bind_Dot1q_Port',
+ 'ascend_first_dest' => 'Ascend-First-Dest',
+ 'x_ascend_if_netmask' => 'X-Ascend-IF-Netmask',
+ 'tunnel_session_auth_serv' => 'Tunnel_Session_Auth_Service_Grp',
+ 'annex_local_ip_address' => 'Annex-Local-IP-Address',
+ 'termination_menu' => 'Termination-Menu',
+ 'ms_chap2_cpw' => 'MS-CHAP2-CPW',
+ 'ascend_mpp_idle_percent' => 'Ascend-MPP-Idle-Percent',
+ 'usr_characters_sent' => 'USR-Characters-Sent',
+ 'eap_message' => 'EAP-Message',
+ 'acct_delay_time' => 'Acct-Delay-Time',
+ 'ascend_remote_fw' => 'Ascend-Remote-FW',
+ 'x_ascend_tunneling_proto' => 'X-Ascend-Tunneling-Protocol',
+ 'shiva_session_id' => 'Shiva-Session-Id',
+ 'usr_igmp_query_interval' => 'USR-IGMP-Query-Interval',
+ 'usr_accm_type' => 'USR-ACCM-Type',
+ 'usr_call_terminate_in_gm' => 'USR-Call-Terminate-in-GMT',
+ 'usr_rad_location_type' => 'USR-Rad-Location-Type',
+ 'ascend_filter' => 'Ascend-Filter',
+ 'ascend_primary_home_agen' => 'Ascend-Primary-Home-Agent',
+ 'x_ascend_user_acct_host' => 'X-Ascend-User-Acct-Host',
+ 'chap_challenge' => 'CHAP-Challenge',
+ 'acct_output_packets_64' => 'Acct_Output_Packets_64',
+ 'bind_auth_max_sessions' => 'Bind_Auth_Max_Sessions',
+ 'cisco_pre_output_octets' => 'Cisco-Pre-Output-Octets',
+ 'x_ascend_fr_direct' => 'X-Ascend-FR-Direct',
+ 'x_ascend_client_secondar' => 'X-Ascend-Client-Secondary-DNS',
+ 'usr_rmmie_pwrlvl_nearech' => 'USR-RMMIE-PwrLvl-NearEcho-Canc',
+ 'ascend_bridge_address' => 'Ascend-Bridge-Address',
+ 'user_name' => 'User-Name',
+ 'usr_rmmie_firmware_build' => 'USR-RMMIE-Firmware-Build-Date',
+ 'ms_chap_mppe_keys' => 'MS-CHAP-MPPE-Keys',
+ 'usr_number_of_characters' => 'USR-Number-Of-Characters-Lost',
+ 'usr_physical_state' => 'USR-Physical-State',
+ 'x_ascend_assign_ip_serve' => 'X-Ascend-Assign-IP-Server',
+ 'bind_int_context' => 'Bind_Int_Context',
+ 'erx_tunnel_virtual_route' => 'ERX-Tunnel-Virtual-Router',
+ 'ascend_xmit_rate' => 'Ascend-Xmit-Rate',
+ 'usr_secondary_dns_server' => 'USR-Secondary_DNS_Server',
+ 'ascend_dsl_rate_mode' => 'Ascend-Dsl-Rate-Mode',
+ 'ascend_data_rate' => 'Ascend-Data-Rate',
+ 'realm' => 'Realm',
+ 'usr_ipx_call_input_filte' => 'USR-IPX-Call-Input-Filter',
+ 'ascend_ipx_route' => 'Ascend-IPX-Route',
+ 'usr_failure_to_connect_r' => 'USR-Failure-to-Connect-Reason',
+ 'x_ascend_home_network_na' => 'X-Ascend-Home-Network-Name',
+ 'acc_nbns_server_pri' => 'Acc-Nbns-Server-Pri',
+ 'usr_modulation_type' => 'USR-Modulation-Type',
+ 'service_type' => 'Service-Type',
+ 'ascend_callback_delay' => 'Ascend-Callback-Delay',
+ 'ascend_owner_ip_addr' => 'Ascend-Owner-IP-Addr',
+ 'x_ascend_handle_ipx' => 'X-Ascend-Handle-IPX',
+ 'usr_connect_term_reason' => 'USR-Connect-Term-Reason',
+ 'x_ascend_multicast_rate_' => 'X-Ascend-Multicast-Rate-Limit',
+ 'h323_disconnect_time' => 'h323-disconnect-time',
+ 'acc_ip_gateway_sec' => 'Acc-Ip-Gateway-Sec',
+ 'usr_number_of_blers' => 'USR-Number-of-Blers',
+ 'x_ascend_fr_type' => 'X-Ascend-FR-Type',
+ 'ascend_assign_ip_pool' => 'Ascend-Assign-IP-Pool',
+ 'ascend_qos_upstream' => 'Ascend-QOS-Upstream',
+ 'usr_nas_type' => 'USR-NAS-Type',
+ 'acc_dial_port_index' => 'Acc-Dial-Port-Index',
+ 'usr_initial_tx_link_data' => 'USR-Initial-Tx-Link-Data-Rate',
+ 'ascend_fr_type' => 'Ascend-FR-Type',
+ 'usr_mbi_ct_tdm_time_slot' => 'USR-Mbi_Ct_TDM_Time_Slot',
+ 'usr_rmmie_pwrlvl_xmit_lv' => 'USR-RMMIE-PwrLvl-Xmit-Lvl',
+ 'erx_atm_service_category' => 'ERX-Atm-Service-Category',
+ 'usr_appletalk' => 'USR-Appletalk',
+ 'usr_send_script1' => 'USR-Send-Script1',
+ 'usr_send_script2' => 'USR-Send-Script2',
+ 'usr_send_script3' => 'USR-Send-Script3',
+ 'usr_ospf_addressless_ind' => 'USR-OSPF-Addressless-Index',
+ 'acct_input_packets' => 'Acct-Input-Packets',
+ 'usr_send_script4' => 'USR-Send-Script4',
+ 'usr_send_script5' => 'USR-Send-Script5',
+ 'usr_send_script6' => 'USR-Send-Script6',
+ 'usr_service_option' => 'USR-Service-Option',
+ 'ascend_dropped_octets' => 'Ascend-Dropped-Octets',
+ 'usr_ip' => 'USR-IP',
+ 'usr_tunnel_security' => 'USR-Tunnel-Security',
+ 'acc_acct_on_off_reason' => 'Acc-Acct-On-Off-Reason',
+ 'shiva_compression_type' => 'Shiva-Compression-Type',
+ 'ascend_pw_warntime' => 'Ascend-PW-Warntime',
+ 'usr_security_resp_limit' => 'USR-Security-Resp-Limit',
+ 'ascend_x25_pad_prompt' => 'Ascend-X25-Pad-Prompt',
+ 'cisco_asing_ip_pool' => 'Cisco-Asing-IP-Pool',
+ 'acc_route_policy' => 'Acc-Route-Policy',
+ 'annex_local_username' => 'Annex-Local-Username',
+ 'x_ascend_call_by_call' => 'X-Ascend-Call-By-Call',
+ 'ascend_calling_id_screen' => 'Ascend-Calling-Id-Screening',
+ 'x_ascend_dhcp_pool_numbe' => 'X-Ascend-DHCP-Pool-Number',
+ 'nas_port_type' => 'NAS-Port-Type',
+ 'ascend_route_ip' => 'Ascend-Route-IP',
+ 'ascend_client_gateway' => 'Ascend-Client-Gateway',
+ 'ascend_qos_downstream' => 'Ascend-QOS-Downstream',
+ 'ms_bap_usage' => 'MS-BAP-Usage',
+ 'usr_vts_session_key' => 'USR-VTS-Session-Key',
+ 'usr_receive_acc_map' => 'USR-Receive-Acc-Map',
+ 'ascend_expect_callback' => 'Ascend-Expect-Callback',
+ 'password' => 'Password',
+ 'packet_type' => 'Packet-Type',
+ 'ascend_remote_addr' => 'Ascend-Remote-Addr',
+ 'ascend_recv_name' => 'Ascend-Recv-Name',
+ 'ms_acct_eap_type' => 'MS-Acct-EAP-Type',
+ 'usr_filter_zones' => 'USR-Filter-Zones',
+ 'annex_output_filter' => 'Annex-Output-Filter',
+ 'usr_rmmie_rcv_tot_pwrlvl' => 'USR-RMMIE-Rcv-Tot-PwrLvl',
+ 'usr_mp_mrru' => 'USR-MP-MRRU',
+ 'ascend_call_filter' => 'Ascend-Call-Filter',
+ 'usr_keypress_timeout' => 'USR-Keypress-Timeout',
+ 'usr_modem_setup_time' => 'USR-Modem-Setup-Time',
+ 'acct_authentic' => 'Acct-Authentic',
+ 'pppoe_motm' => 'PPPOE_MOTM',
+ 'x_ascend_expect_callback' => 'X-Ascend-Expect-Callback',
+ 'erx_atm_scr' => 'ERX-Atm-SCR',
+ 'erx_address_pool_name' => 'ERX-Address-Pool-Name',
+ 'challenge_state' => 'Challenge-State',
+ 'usr_multicast_proxy' => 'USR-Multicast-Proxy',
+ 'framed_filter_id' => 'Framed-Filter-Id',
+ 'add_suffix' => 'Add-Suffix',
+ 'ascend_auth_type' => 'Ascend-Auth-Type',
+ 'session_timeout' => 'Session-Timeout',
+ 'ascend_callback' => 'Ascend-Callback',
+ 'usr_chat_script_name' => 'USR-Chat-Script-Name',
+ 'port_message' => 'Port-Message',
+ 'acct_output_packets' => 'Acct-Output-Packets',
+ 'ascend_session_svr_key' => 'Ascend-Session-Svr-Key',
+ 'login_tcp_port' => 'Login-TCP-Port',
+ 'erx_tunnel_password' => 'ERX-Tunnel-Password',
+ 'shasta_user_privilege' => 'Shasta-User-Privilege',
+ 'usr_secondary_nbns_serve' => 'USR-Secondary_NBNS_Server',
+ 'usr_security_login_limit' => 'USR-Security-Login-Limit',
+ 'usr_start_time' => 'USR-Start-Time',
+ 'acc_access_partition' => 'Acc-Access-Partition',
+ 'versanet_termination_cau' => 'Versanet-Termination-Cause',
+ 'x_ascend_call_block_dura' => 'X-Ascend-Call-Block-Duration',
+ 'mcast_maxgroups' => 'Mcast_MaxGroups',
+ 'ascend_user_acct_base' => 'Ascend-User-Acct-Base',
+ 'usr_vpn_gw_location_id' => 'USR-VPN-GW-Location-Id',
+ 'usr_block_error_count_li' => 'USR-Block-Error-Count-Limit',
+ 'ascend_telnet_profile' => 'Ascend-Telnet-Profile',
+ 'ascend_port_redir_protoc' => 'Ascend-Port-Redir-Protocol',
+ 'ascend_call_by_call' => 'Ascend-Call-By-Call',
+ 'usr_disconnect_cause_ind' => 'USR-Disconnect-Cause-Indicator',
+ 'x_ascend_fr_linkup' => 'X-Ascend-FR-LinkUp',
+ 'ascend_billing_number' => 'Ascend-Billing-Number',
+ 'usr_ds0s' => 'USR-DS0s',
+ 'usr_at_zip_output_filter' => 'USR-AT-Zip-Output-Filter',
+ 'ascend_user_acct_port' => 'Ascend-User-Acct-Port',
+ 'login_port' => 'Login-Port',
+ 'arap_security' => 'ARAP-Security',
+ 'tunnel_deadtime' => 'Tunnel_Deadtime',
+ 'ascend_user_acct_time' => 'Ascend-User-Acct-Time',
+ 'ms_chap_challenge' => 'MS-CHAP-Challenge',
+ 'ascend_x25_rpoa' => 'Ascend-X25-Rpoa',
+ 'login_time' => 'Login-Time',
+ 'current_time' => 'Current-Time',
+ 'login_service' => 'Login-Service',
+ 'ascend_menu_selector' => 'Ascend-Menu-Selector',
+ 'ascend_bacp_enable' => 'Ascend-BACP-Enable',
+ 'shiva_link_speed' => 'Shiva-Link-Speed',
+ 'ascend_private_route_tab' => 'Ascend-Private-Route-Table-ID',
+ 'x_ascend_session_svr_key' => 'X-Ascend-Session-Svr-Key',
+ 'ascend_data_filter' => 'Ascend-Data-Filter',
+ 'ascend_target_util' => 'Ascend-Target-Util',
+ 'shiva_function' => 'Shiva-Function',
+ 'usr_pw_usr_ifilter_ip' => 'USR-PW_USR_IFilter_IP',
+ 'usr_igmp_routing' => 'USR-IGMP-Routing',
+ 'acc_tunnel_port' => 'Acc-Tunnel-Port',
+ 'x_ascend_fr_n391' => 'X-Ascend-FR-N391',
+ 'medium_type' => 'Medium_Type',
+ 'annex_domain_name' => 'Annex-Domain-Name',
+ 'ascend_fr_n391' => 'Ascend-FR-N391',
+ 'callback_number' => 'Callback-Number',
+ 'usr_chassis_temperature' => 'USR-Chassis-Temperature',
+ 'dialback_no' => 'Dialback-No',
+ 'ms_mppe_recv_key' => 'MS-MPPE-Recv-Key',
+ 'ascend_ipx_alias' => 'Ascend-IPX-Alias',
+ 'le_nat_inmap' => 'LE-NAT-Inmap',
+ 'tunnel_police_rate' => 'Tunnel_Police_Rate',
+ 'acct_terminate_cause' => 'Acct-Terminate-Cause',
+ 'le_nat_other_session_tim' => 'LE-NAT-Other-Session-Timeout',
+ 'usr_ip_rip_output_filter' => 'USR-IP-RIP-Output-Filter',
+ 'exec_program' => 'Exec-Program',
+ 'h323_disconnect_cause' => 'h323-disconnect-cause',
+ 'usr_chassis_call_channel' => 'USR-Chassis-Call-Channel',
+ 'x_ascend_fr_dlci' => 'X-Ascend-FR-DLCI',
+ 'ms_link_drop_time_limit' => 'MS-Link-Drop-Time-Limit',
+ 'acc_callback_num_valid' => 'Acc-Callback-Num-Valid',
+ 'cisco_presession_time' => 'Cisco-PreSession-Time',
+ 'ms_chap_response' => 'MS-CHAP-Response',
+ 'usr_spoofing' => 'USR-Spoofing',
+ 'usr_num_fax_pages_proces' => 'USR-Num-Fax-Pages-Processed',
+ 'ascend_x25_cug' => 'Ascend-X25-Cug',
+ 'ascend_fr_dlci' => 'Ascend-FR-DLCI',
+ 'shiva_user_attributes' => 'Shiva-User-Attributes',
+ 'ms_chap_lm_enc_pw' => 'MS-CHAP-LM-Enc-PW',
+ 'ascend_transit_number' => 'Ascend-Transit-Number',
+ 'usr_last_number_dialed_i' => 'USR-Last-Number-Dialed-In-DNIS',
+ 'usr_ip_saa_filter' => 'USR-IP-SAA-Filter',
+ 'usr_pw_usr_ifilter_ipx' => 'USR-PW_USR_IFilter_IPX',
+ 'ascend_remove_seconds' => 'Ascend-Remove-Seconds',
+ 'le_connect_detail' => 'LE-Connect-Detail',
+ 'ascend_assign_ip_global_' => 'Ascend-Assign-IP-Global-Pool',
+ 'proxy_to_realm' => 'Proxy-To-Realm',
+ 'usr_retrains_requested' => 'USR-Retrains-Requested',
+ 'h323_remote_address' => 'h323-remote-address',
+ 'ascend_x25_nui_prompt' => 'Ascend-X25-Nui-Prompt',
+ 'acc_customer_id' => 'Acc-Customer-Id',
+ 'ms_chap2_response' => 'MS-CHAP2-Response',
+ 'ascend_host_info' => 'Ascend-Host-Info',
+ 'annex_addr_resolution_se' => 'Annex-Addr-Resolution-Servers',
+ 'x_ascend_multilink_id' => 'X-Ascend-Multilink-ID',
+ 'login_lat_service' => 'Login-LAT-Service',
+ 'usr_rmmie_rcv_pwrlvl_330' => 'USR-RMMIE-Rcv-PwrLvl-3300Hz',
+ 'ascend_event_type' => 'Ascend-Event-Type',
+ 'ascend_inc_channel_count' => 'Ascend-Inc-Channel-Count',
+ 'cisco_ppp_async_map' => 'Cisco-PPP-Async-Map',
+ 'usr_min_compression_size' => 'USR-Min-Compression-Size',
+ 'ascend_traffic_shaper' => 'Ascend-Traffic-Shaper',
+ 'ascend_user_acct_key' => 'Ascend-User-Acct-Key',
+ 'usr_port_tap_output' => 'USR-Port-Tap-Output',
+ 'ascend_x25_nui' => 'Ascend-X25-Nui',
+ 'x_ascend_disconnect_caus' => 'X-Ascend-Disconnect-Cause',
+ 'ascend_cbcp_enable' => 'Ascend-CBCP-Enable',
+ 'usr_framed_ip_address_po' => 'USR-Framed_IP_Address_Pool_Name',
+ 'ascend_x25_profile_name' => 'Ascend-X25-Profile-Name',
+ 'usr_orig_nas_type' => 'USR-Orig-NAS-Type',
+ 'acc_output_errors' => 'Acc-Output-Errors',
+ 'h323_redirect_ip_address' => 'h323-redirect-ip-address',
+ 'usr_ip_call_output_filte' => 'USR-IP-Call-Output-Filter',
+ 'cisco_avpair' => 'Cisco-AVPair',
+ 'usr_slot_connected_to' => 'USR-Slot-Connected-To',
+ 'framed_route' => 'Framed-Route',
+ 'ascend_global_call_id' => 'Ascend-Global-Call-Id',
+ 'x_ascend_seconds_of_hist' => 'X-Ascend-Seconds-Of-History',
+ 'x_ascend_temporary_rtes' => 'X-Ascend-Temporary-Rtes',
+ 'h323_currency_type' => 'h323-currency-type',
+ 'x_ascend_token_expiry' => 'X-Ascend-Token-Expiry',
+ 'pvc_encapsulation_type' => 'PVC_Encapsulation_Type',
+ 'x_ascend_pw_lifetime' => 'X-Ascend-PW-Lifetime',
+ 'usr_expected_voltage' => 'USR-Expected-Voltage',
+ 'usr_simplified_v42bis_us' => 'USR-Simplified-V42bis-Usage',
+ 'shiva_customer_id' => 'Shiva-Customer-Id',
+ 'usr_compression_algorith' => 'USR-Compression-Algorithm',
+ 'annex_system_disc_reason' => 'Annex-System-Disc-Reason',
+ 'annex_secondary_nbns_ser' => 'Annex-Secondary-NBNS-Server',
+ 'usr_q931_call_reference_' => 'USR-Q931-Call-Reference-Value',
+ 'usr_send_password' => 'USR-Send-Password',
+ 'prompt' => 'Prompt',
+ 'usr_cusr_hat_script_rule' => 'USR-CUSR-hat-Script-Rules',
+ 'usr_event_id' => 'USR-Event-Id',
+ 'usr_ccp_algorithm' => 'USR-CCP-Algorithm',
+ 'usr_mbi_ct_bchannel_used' => 'USR-Mbi_Ct_BChannel_Used',
+ 'ascend_svc_enabled' => 'Ascend-SVC-Enabled',
+ 'framed_mtu' => 'Framed-MTU',
+ 'acc_reason_code' => 'Acc-Reason-Code',
+ 'bind_l2tp_flow_control' => 'Bind_L2TP_Flow_Control',
+ 'ascend_cbcp_delay' => 'Ascend-CBCP-Delay',
+ 'le_ipsec_deny_action' => 'LE-IPSec-Deny-Action',
+
+ #NOMENT
+ 'nomadix_bw_down' => 'Nomadix-Bw-Down',
+ 'nomadix_bw_up' => 'Nomadix-Bw-Up',
+ 'nomadix_ip_upsell' => 'Nomadix-IP-Upsell',
+);
+
+1;
--- /dev/null
+package FS::radius_usergroup;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+use FS::svc_acct;
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::radius_usergroup - Object methods for radius_usergroup records
+
+=head1 SYNOPSIS
+
+ use FS::radius_usergroup;
+
+ $record = new FS::radius_usergroup \%hash;
+ $record = new FS::radius_usergroup { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::radius_usergroup object links an account (see L<FS::svc_acct>) with a
+RADIUS group. FS::radius_usergroup inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item usergroupnum - primary key
+
+=item svcnum - Account (see L<FS::svc_acct>).
+
+=item groupname - group name
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record. To add the record to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'radius_usergroup'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+#inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+#inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+#inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('usergroupnum')
+ || $self->ut_number('svcnum')
+ || $self->ut_foreign_key('svcnum','svc_acct','svcnum')
+ || $self->ut_text('groupname')
+ ;
+}
+
+=item svc_acct
+
+Returns the account associated with this record (see L<FS::svc_acct>).
+
+=cut
+
+sub svc_acct {
+ my $self = shift;
+ qsearchs('svc_acct', { svcnum => $self->svcnum } );
+}
+
+=back
+
+=head1 BUGS
+
+Don't let 'em get you down.
+
+=head1 SEE ALSO
+
+L<svc_acct>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::session;
+
+use strict;
+use vars qw( @ISA $conf $start $stop );
+use FS::UID qw( dbh );
+use FS::Record qw( qsearchs );
+use FS::svc_acct;
+use FS::port;
+use FS::nas;
+
+@ISA = qw(FS::Record);
+
+$FS::UID::callback{'FS::session'} = sub {
+ $conf = new FS::Conf;
+ $start = $conf->exists('session-start') ? $conf->config('session-start') : '';
+ $stop = $conf->exists('session-stop') ? $conf->config('session-stop') : '';
+};
+
+=head1 NAME
+
+FS::session - Object methods for session records
+
+=head1 SYNOPSIS
+
+ use FS::session;
+
+ $record = new FS::session \%hash;
+ $record = new FS::session {
+ 'portnum' => 1,
+ 'svcnum' => 2,
+ 'login' => $timestamp,
+ 'logout' => $timestamp,
+ };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->nas_heartbeat($timestamp);
+
+=head1 DESCRIPTION
+
+An FS::session object represents an user login session. FS::session inherits
+from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item sessionnum - primary key
+
+=item portnum - NAS port for this session - see L<FS::port>
+
+=item svcnum - User for this session - see L<FS::svc_acct>
+
+=item login - timestamp indicating the beginning of this user session.
+
+=item logout - timestamp indicating the end of this user session. May be null,
+ which indicates a currently open session.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new session. To add the session to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'session'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false. If the `login' field is empty, it is replaced with
+the current time.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ $error = $self->check;
+ return $error if $error;
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ if ( qsearchs('session', { 'portnum' => $self->portnum, 'logout' => '' } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "a session on that port is already open!";
+ }
+
+ $self->setfield('login', time()) unless $self->getfield('login');
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $self->nas_heartbeat($self->getfield('login'));
+
+ #session-starting callback
+ #redundant with heartbeat, yuck
+ my $port = qsearchs('port',{'portnum'=>$self->portnum});
+ my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
+ #kcuy
+ my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
+ system( eval qq("$start") ) if $start;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false. If the `logout' field is empty,
+it is replaced with the current time.
+
+=cut
+
+sub replace {
+ my($self, $old) = @_;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $self->check;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $self->setfield('logout', time()) unless $self->getfield('logout');
+
+ $error = $self->SUPER::replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $self->nas_heartbeat($self->getfield('logout'));
+
+ #session-ending callback
+ #redundant with heartbeat, yuck
+ my $port = qsearchs('port',{'portnum'=>$self->portnum});
+ my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
+ #kcuy
+ my( $ip, $nasip, $nasfqdn ) = ( $port->ip, $nas->nasip, $nas->nasfqdn );
+ system( eval qq("$stop") ) if $stop;
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item check
+
+Checks all fields to make sure this is a valid session. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+ my $error =
+ $self->ut_numbern('sessionnum')
+ || $self->ut_number('portnum')
+ || $self->ut_number('svcnum')
+ || $self->ut_numbern('login')
+ || $self->ut_numbern('logout')
+ ;
+ return $error if $error;
+ return "Unknown svcnum"
+ unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
+ '';
+}
+
+=item nas_heartbeat
+
+Heartbeats the nas associated with this session (see L<FS::nas>).
+
+=cut
+
+sub nas_heartbeat {
+ my $self = shift;
+ my $port = qsearchs('port',{'portnum'=>$self->portnum});
+ my $nas = qsearchs('nas',{'nasnum'=>$port->nasnum});
+ $nas->heartbeat(shift);
+}
+
+=item svc_acct
+
+Returns the svc_acct record associated with this session (see L<FS::svc_acct>).
+
+=cut
+
+sub svc_acct {
+ my $self = shift;
+ qsearchs('svc_acct', { 'svcnum' => $self->svcnum } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $
+
+=head1 BUGS
+
+Maybe you shouldn't be able to insert a session if there's currently an open
+session on that port. Or maybe the open session on that port should be flagged
+as problematic? autoclosed? *sigh*
+
+Hmm, sessions refer to current svc_acct records... probably need to constrain
+deletions to svc_acct records such that no svc_acct records are deleted which
+have a session (even if long-closed).
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::svc_Common;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs fields dbh );
+use FS::cust_svc;
+use FS::part_svc;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::svc_Common - Object method for all svc_ records
+
+=head1 SYNOPSIS
+
+use FS::svc_Common;
+
+@ISA = qw( FS::svc_Common );
+
+=head1 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.
+
+=head1 METHODS
+
+=over 4
+
+=item 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 L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $self->check;
+ return $error if $error;
+
+ my $svcnum = $self->svcnum;
+ my $cust_svc;
+ unless ( $svcnum ) {
+ $cust_svc = new FS::cust_svc ( {
+ #hua?# 'svcnum' => $svcnum,
+ 'pkgnum' => $self->pkgnum,
+ 'svcpart' => $self->svcpart,
+ } );
+ $error = $cust_svc->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $svcnum = $self->svcnum($cust_svc->svcnum);
+ } else {
+ $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
+ unless ( $cust_svc ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "no cust_svc record found for svcnum ". $self->svcnum;
+ }
+ $self->pkgnum($cust_svc->pkgnum);
+ $self->svcpart($cust_svc->svcpart);
+ }
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item 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.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $svcnum = $self->svcnum;
+
+ $error = $self->SUPER::delete;
+ return $error if $error;
+
+ my $cust_svc = $self->cust_svc;
+ $error = $cust_svc->delete;
+ return $error if $error;
+
+ '';
+}
+
+=item setfixed
+
+Sets any fixed fields for this service (see L<FS::part_svc>). 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.
+
+=cut
+
+sub setfixed {
+ my $self = shift;
+ $self->setx('F');
+}
+
+=item setdefault
+
+Sets all fields to their defaults (see L<FS::part_svc>), 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).
+
+=cut
+
+sub setdefault {
+ my $self = shift;
+ $self->setx('D');
+}
+
+sub setx {
+ my $self = shift;
+ my $x = shift;
+
+ my $error;
+
+ $error =
+ $self->ut_numbern('svcnum')
+ ;
+ return $error if $error;
+
+ #get part_svc
+ my $svcpart;
+ if ( $self->svcnum ) {
+ my $cust_svc = $self->cust_svc;
+ return "Unknown svcnum" unless $cust_svc;
+ $svcpart = $cust_svc->svcpart;
+ } else {
+ $svcpart = $self->getfield('svcpart');
+ }
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
+ return "Unkonwn svcpart" unless $part_svc;
+
+ #set default/fixed/whatever fields from part_svc
+ my $table = $self->table;
+ foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) {
+ my $part_svc_column = $part_svc->part_svc_column($field);
+ if ( $part_svc_column->columnflag eq $x ) {
+ $self->setfield( $field, $part_svc_column->columnvalue );
+ }
+ }
+
+ $part_svc;
+
+}
+
+=item cust_svc
+
+Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
+object (see L<FS::cust_svc>).
+
+=cut
+
+sub cust_svc {
+ my $self = shift;
+ qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
+}
+
+=item suspend
+
+=item unsuspend
+
+=item 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 L<FS::cust_pkg>).
+
+=cut
+
+sub suspend { ''; }
+sub unsuspend { ''; }
+sub cancel { ''; }
+
+=back
+
+=head1 VERSION
+
+$Id: svc_Common.pm,v 1.8 2002-03-18 16:05:35 ivan Exp $
+
+=head1 BUGS
+
+The setfixed method return value.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
+from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::svc_acct;
+
+use strict;
+use vars qw( @ISA $noexport_hack $conf
+ $dir_prefix @shells $usernamemin
+ $usernamemax $passwordmin $passwordmax
+ $username_ampersand $username_letter $username_letterfirst
+ $username_noperiod $username_nounderscore $username_nodash
+ $username_uppercase
+ $mydomain
+ $dirhash
+ @saltset @pw_set );
+use Carp;
+use Fcntl qw(:flock);
+use FS::UID qw( datasrc );
+use FS::Conf;
+use FS::Record qw( qsearch qsearchs fields dbh );
+use FS::svc_Common;
+use Net::SSH;
+use FS::part_svc;
+use FS::svc_acct_pop;
+use FS::svc_acct_sm;
+use FS::cust_main_invoice;
+use FS::svc_domain;
+use FS::raddb;
+use FS::queue;
+use FS::radius_usergroup;
+use FS::Msgcat qw(gettext);
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::svc_acct'} = sub {
+ $conf = new FS::Conf;
+ $dir_prefix = $conf->config('home');
+ @shells = $conf->config('shells');
+ $usernamemin = $conf->config('usernamemin') || 2;
+ $usernamemax = $conf->config('usernamemax');
+ $passwordmin = $conf->config('passwordmin') || 6;
+ $passwordmax = $conf->config('passwordmax') || 8;
+ $username_letter = $conf->exists('username-letter');
+ $username_letterfirst = $conf->exists('username-letterfirst');
+ $username_noperiod = $conf->exists('username-noperiod');
+ $username_nounderscore = $conf->exists('username-nounderscore');
+ $username_nodash = $conf->exists('username-nodash');
+ $username_uppercase = $conf->exists('username-uppercase');
+ $username_ampersand = $conf->exists('username-ampersand');
+ $mydomain = $conf->config('domain');
+
+ $dirhash = $conf->config('dirhash') || 0;
+};
+
+@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
+
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ if ( $hashref->{'svc_acct_svcnum'} ) {
+ $self->{'_domsvc'} = FS::svc_domain->new( {
+ 'svcnum' => $hashref->{'domsvc'},
+ 'domain' => $hashref->{'svc_acct_domain'},
+ 'catchall' => $hashref->{'svc_acct_catchall'},
+ } );
+ }
+}
+
+=head1 NAME
+
+FS::svc_acct - Object methods for svc_acct records
+
+=head1 SYNOPSIS
+
+ use FS::svc_acct;
+
+ $record = new FS::svc_acct \%hash;
+ $record = new FS::svc_acct { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+ %hash = $record->radius;
+
+ %hash = $record->radius_reply;
+
+ %hash = $record->radius_check;
+
+ $domain = $record->domain;
+
+ $svc_domain = $record->svc_domain;
+
+ $email = $record->email;
+
+ $seconds_since = $record->seconds_since($timestamp);
+
+=head1 DESCRIPTION
+
+An FS::svc_acct object represents an account. FS::svc_acct inherits from
+FS::svc_Common. The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key (assigned automatcially for new accounts)
+
+=item username
+
+=item _password - generated if blank
+
+=item sec_phrase - security phrase
+
+=item popnum - Point of presence (see L<FS::svc_acct_pop>)
+
+=item uid
+
+=item gid
+
+=item finger - GECOS
+
+=item dir - set automatically if blank (and uid is not)
+
+=item shell
+
+=item quota - (unimplementd)
+
+=item slipip - IP address
+
+=item seconds -
+
+=item domsvc - svcnum from svc_domain
+
+=item radius_I<Radius_Attribute> - I<Radius-Attribute>
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new account. To add the account to the database, see L<"insert">.
+
+=cut
+
+sub table { 'svc_acct'; }
+
+=item insert
+
+Adds this account to the database. If there is an error, returns the error,
+otherwise returns false.
+
+The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+The additional field I<usergroup> can optionally be defined; if so it should
+contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
+sqlradius export only)
+
+(TODOC: L<FS::queue> and L<freeside-queued>)
+
+(TODOC: new exports! $noexport_hack)
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $self->check;
+ return $error if $error;
+
+ return gettext('username_in_use'). ": ". $self->username
+ if qsearchs( 'svc_acct', { 'username' => $self->username,
+ 'domsvc' => $self->domsvc,
+ } );
+
+ if ( $self->svcnum ) {
+ my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
+ unless ( $cust_svc ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "no cust_svc record found for svcnum ". $self->svcnum;
+ }
+ $self->pkgnum($cust_svc->pkgnum);
+ $self->svcpart($cust_svc->svcpart);
+ }
+
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+ return "Unknown svcpart" unless $part_svc;
+ return "uid in use"
+ if $part_svc->part_svc_column('uid')->columnflag ne 'F'
+ && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
+ && $self->username !~ /^(hyla)?fax$/
+ && $self->username !~ /^toor$/ #FreeBSD
+ ;
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( $self->usergroup ) {
+ foreach my $groupname ( @{$self->usergroup} ) {
+ my $radius_usergroup = new FS::radius_usergroup ( {
+ svcnum => $self->svcnum,
+ groupname => $groupname,
+ } );
+ my $error = $radius_usergroup->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ #new-style exports!
+ unless ( $noexport_hack ) {
+ foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+ my $error = $part_export->export_insert($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
+
+=item 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.
+
+(TODOC: new exports! $noexport_hack)
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
+ return "Can't delete an account which has (svc_acct_sm) mail aliases!"
+ if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
+ }
+
+ return "Can't delete an account which is a (svc_forward) source!"
+ if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
+
+ return "Can't delete an account which is a (svc_forward) destination!"
+ if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
+
+ return "Can't delete an account with (svc_www) web service!"
+ if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
+
+ # what about records in session ? (they should refer to history table)
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_main_invoice (
+ qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
+ ) {
+ unless ( defined($cust_main_invoice) ) {
+ warn "WARNING: something's wrong with qsearch";
+ next;
+ }
+ my %hash = $cust_main_invoice->hash;
+ $hash{'dest'} = $self->email;
+ my $new = new FS::cust_main_invoice \%hash;
+ my $error = $new->replace($cust_main_invoice);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ foreach my $svc_domain (
+ qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
+ ) {
+ my %hash = new FS::svc_domain->hash;
+ $hash{'catchall'} = '';
+ my $new = new FS::svc_domain \%hash;
+ my $error = $new->replace($svc_domain);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ foreach my $radius_usergroup (
+ qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
+ ) {
+ my $error = $radius_usergroup->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ my $part_svc = $self->cust_svc->part_svc;
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ #new-style exports!
+ unless ( $noexport_hack ) {
+ foreach my $part_export ( $part_svc->part_export ) {
+ my $error = $part_export->export_delete($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+The additional field I<usergroup> can optionally be defined; if so it should
+contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
+sqlradius export only)
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ return "Username in use"
+ if $old->username ne $new->username &&
+ qsearchs( 'svc_acct', { 'username' => $new->username,
+ 'domsvc' => $new->domsvc,
+ } );
+ {
+ #no warnings 'numeric'; #alas, a 5.006-ism
+ local($^W) = 0;
+ return "Can't change uid!" if $old->uid != $new->uid;
+ }
+
+ #change homdir when we change username
+ $new->setfield('dir', '') if $old->username ne $new->username;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $new->SUPER::replace($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error if $error;
+ }
+
+ $old->usergroup( [ $old->radius_groups ] );
+ if ( $new->usergroup ) {
+ #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
+ my @newgroups = @{$new->usergroup};
+ foreach my $oldgroup ( @{$old->usergroup} ) {
+ if ( grep { $oldgroup eq $_ } @newgroups ) {
+ @newgroups = grep { $oldgroup ne $_ } @newgroups;
+ next;
+ }
+ my $radius_usergroup = qsearchs('radius_usergroup', {
+ svcnum => $old->svcnum,
+ groupname => $oldgroup,
+ } );
+ my $error = $radius_usergroup->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error deleting radius_usergroup $oldgroup: $error";
+ }
+ }
+
+ foreach my $newgroup ( @newgroups ) {
+ my $radius_usergroup = new FS::radius_usergroup ( {
+ svcnum => $new->svcnum,
+ groupname => $newgroup,
+ } );
+ my $error = $radius_usergroup->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error adding radius_usergroup $newgroup: $error";
+ }
+ }
+
+ }
+
+ #new-style exports!
+ unless ( $noexport_hack ) {
+ foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
+ my $error = $part_export->export_replace($new,$old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
+
+=item suspend
+
+Suspends this account by prefixing *SUSPENDED* to the password. If there is an
+error, returns the error, otherwise returns false.
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=cut
+
+sub suspend {
+ my $self = shift;
+ my %hash = $self->hash;
+ unless ( $hash{_password} =~ /^\*SUSPENDED\* /
+ || $hash{_password} eq '*'
+ ) {
+ $hash{_password} = '*SUSPENDED* '.$hash{_password};
+ my $new = new FS::svc_acct ( \%hash );
+ $new->replace($self);
+ } else {
+ ''; #no error (already suspended)
+ }
+}
+
+=item unsuspend
+
+Unsuspends this account by removing *SUSPENDED* from the password. If there is
+an error, returns the error, otherwise returns false.
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=cut
+
+sub unsuspend {
+ my $self = shift;
+ my %hash = $self->hash;
+ if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
+ $hash{_password} = $1;
+ my $new = new FS::svc_acct ( \%hash );
+ $new->replace($self);
+ } else {
+ ''; #no error (already unsuspended)
+ }
+}
+
+=item cancel
+
+Just returns false (no error) for now.
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid service. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+Sets any fixed values; see L<FS::part_svc>.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my($recref) = $self->hashref;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
+
+ if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
+ $self->usergroup(
+ [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
+ }
+
+ my $error = $self->ut_numbern('svcnum')
+ || $self->ut_number('domsvc')
+ || $self->ut_textn('sec_phrase')
+ ;
+ return $error if $error;
+
+ my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
+ if ( $username_uppercase ) {
+ $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
+ or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
+ $recref->{username} = $1;
+ } else {
+ $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
+ or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
+ $recref->{username} = $1;
+ }
+
+ if ( $username_letterfirst ) {
+ $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
+ } elsif ( $username_letter ) {
+ $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
+ }
+ if ( $username_noperiod ) {
+ $recref->{username} =~ /\./ and return gettext('illegal_username');
+ }
+ if ( $username_nounderscore ) {
+ $recref->{username} =~ /_/ and return gettext('illegal_username');
+ }
+ if ( $username_nodash ) {
+ $recref->{username} =~ /\-/ and return gettext('illegal_username');
+ }
+ unless ( $username_ampersand ) {
+ $recref->{username} =~ /\&/ and return gettext('illegal_username');
+ }
+
+ $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
+ $recref->{popnum} = $1;
+ return "Unknown popnum" unless
+ ! $recref->{popnum} ||
+ qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
+
+ unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
+
+ $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
+ $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
+
+ $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
+ $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
+ #not all systems use gid=uid
+ #you can set a fixed gid in part_svc
+
+ return "Only root can have uid 0"
+ if $recref->{uid} == 0
+ && $recref->{username} ne 'root'
+ && $recref->{username} ne 'toor';
+
+# $error = $self->ut_textn('finger');
+# return $error if $error;
+ $self->getfield('finger') =~
+ /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
+ or return "Illegal finger: ". $self->getfield('finger');
+ $self->setfield('finger', $1);
+
+ $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
+ or return "Illegal directory";
+ $recref->{dir} = $1;
+ return "Illegal directory"
+ if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
+ return "Illegal directory"
+ if $recref->{dir} =~ /\&/ && ! $username_ampersand;
+ unless ( $recref->{dir} ) {
+ $recref->{dir} = $dir_prefix . '/';
+ if ( $dirhash > 0 ) {
+ for my $h ( 1 .. $dirhash ) {
+ $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
+ }
+ } elsif ( $dirhash < 0 ) {
+ for my $h ( reverse $dirhash .. -1 ) {
+ $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
+ }
+ }
+ $recref->{dir} .= $recref->{username};
+ ;
+ }
+
+ unless ( $recref->{username} eq 'sync' ) {
+ if ( grep $_ eq $recref->{shell}, @shells ) {
+ $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
+ } else {
+ return "Illegal shell \`". $self->shell. "\'; ".
+ $conf->dir. "/shells contains: @shells";
+ }
+ } else {
+ $recref->{shell} = '/bin/sync';
+ }
+
+ $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
+ $recref->{quota} = $1;
+
+ } else {
+ $recref->{gid} ne '' ?
+ return "Can't have gid without uid" : ( $recref->{gid}='' );
+ $recref->{finger} ne '' ?
+ return "Can't have finger-name without uid" : ( $recref->{finger}='' );
+ $recref->{dir} ne '' ?
+ return "Can't have directory without uid" : ( $recref->{dir}='' );
+ $recref->{shell} ne '' ?
+ return "Can't have shell without uid" : ( $recref->{shell}='' );
+ $recref->{quota} ne '' ?
+ return "Can't have quota without uid" : ( $recref->{quota}='' );
+ }
+
+ unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
+ unless ( $recref->{slipip} eq '0e0' ) {
+ $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
+ or return "Illegal slipip". $self->slipip;
+ $recref->{slipip} = $1;
+ } else {
+ $recref->{slipip} = '0e0';
+ }
+
+ }
+
+ #arbitrary RADIUS stuff; allow ut_textn for now
+ foreach ( grep /^radius_/, fields('svc_acct') ) {
+ $self->ut_textn($_);
+ }
+
+ #generate a password if it is blank
+ $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
+ unless ( $recref->{_password} );
+
+ #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
+ if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
+ $recref->{_password} = $1.$3;
+ #uncomment this to encrypt password immediately upon entry, or run
+ #bin/crypt_pw in cron to give new users a window during which their
+ #password is available to techs, for faxing, etc. (also be aware of
+ #radius issues!)
+ #$recref->{password} = $1.
+ # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
+ #;
+ } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
+ $recref->{_password} = $1.$3;
+ } elsif ( $recref->{_password} eq '*' ) {
+ $recref->{_password} = '*';
+ } elsif ( $recref->{_password} eq '!!' ) {
+ $recref->{_password} = '!!';
+ } else {
+ #return "Illegal password";
+ return gettext('illegal_password'). ": ". $recref->{_password};
+ }
+
+ ''; #no error
+}
+
+=item radius
+
+Depriciated, use radius_reply instead.
+
+=cut
+
+sub radius {
+ carp "FS::svc_acct::radius depriciated, use radius_reply";
+ $_[0]->radius_reply;
+}
+
+=item radius_reply
+
+Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
+reply attributes of this record.
+
+Note that this is now the preferred method for reading RADIUS attributes -
+accessing the columns directly is discouraged, as the column names are
+expected to change in the future.
+
+=cut
+
+sub radius_reply {
+ my $self = shift;
+ my %reply =
+ map {
+ /^(radius_(.*))$/;
+ my($column, $attrib) = ($1, $2);
+ #$attrib =~ s/_/\-/g;
+ ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
+ } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
+ if ( $self->ip && $self->ip ne '0e0' ) {
+ $reply{'Framed-IP-Address'} = $self->ip;
+ }
+ %reply;
+}
+
+=item radius_check
+
+Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
+check attributes of this record.
+
+Note that this is now the preferred method for reading RADIUS attributes -
+accessing the columns directly is discouraged, as the column names are
+expected to change in the future.
+
+=cut
+
+sub radius_check {
+ my $self = shift;
+ ( 'Password' => $self->_password,
+ map {
+ /^(rc_(.*))$/;
+ my($column, $attrib) = ($1, $2);
+ #$attrib =~ s/_/\-/g;
+ ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
+ } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
+ );
+}
+
+=item domain
+
+Returns the domain associated with this account.
+
+=cut
+
+sub domain {
+ my $self = shift;
+ if ( $self->domsvc ) {
+ #$self->svc_domain->domain;
+ my $svc_domain = $self->svc_domain
+ or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
+ $svc_domain->domain;
+ } else {
+ $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
+ }
+}
+
+=item svc_domain
+
+Returns the FS::svc_domain record for this account's domain (see
+L<FS::svc_domain>.
+
+=cut
+
+sub svc_domain {
+ my $self = shift;
+ $self->{'_domsvc'}
+ ? $self->{'_domsvc'}
+ : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
+}
+
+=item cust_svc
+
+Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
+
+sub cust_svc {
+ my $self = shift;
+ qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
+}
+
+=item email
+
+Returns an email address associated with the account.
+
+=cut
+
+sub email {
+ my $self = shift;
+ $self->username. '@'. $self->domain;
+}
+
+=item seconds_since TIMESTAMP
+
+Returns the number of seconds this account has been online since TIMESTAMP.
+See L<FS::session>
+
+TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+#note: POD here, implementation in FS::cust_svc
+sub seconds_since {
+ my $self = shift;
+ $self->cust_svc->seconds_since(@_);
+}
+
+=item radius_groups
+
+Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
+
+=cut
+
+sub radius_groups {
+ my $self = shift;
+ map { $_->groupname }
+ qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
+
+=cut
+
+sub radius_usergroup_selector {
+ my $sel_groups = shift;
+ my %sel_groups = map { $_=>1 } @$sel_groups;
+
+ my $selectname = shift || 'radius_usergroup';
+
+ my $dbh = dbh;
+ my $sth = $dbh->prepare(
+ 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
+ ) or die $dbh->errstr;
+ $sth->execute() or die $sth->errstr;
+ my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
+
+ my $html = <<END;
+ <SCRIPT>
+ function ${selectname}_doadd(object) {
+ var myvalue = object.${selectname}_add.value;
+ var optionName = new Option(myvalue,myvalue,false,true);
+ var length = object.$selectname.length;
+ object.$selectname.options[length] = optionName;
+ object.${selectname}_add.value = "";
+ }
+ </SCRIPT>
+ <SELECT MULTIPLE NAME="$selectname">
+END
+
+ foreach my $group ( @all_groups ) {
+ $html .= '<OPTION';
+ if ( $sel_groups{$group} ) {
+ $html .= ' SELECTED';
+ $sel_groups{$group} = 0;
+ }
+ $html .= ">$group</OPTION>\n";
+ }
+ foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
+ $html .= "<OPTION SELECTED>$group</OPTION>\n";
+ };
+ $html .= '</SELECT>';
+
+ $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
+ qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
+
+ $html;
+}
+
+=head1 BUGS
+
+The $recref stuff in sub check should be cleaned up.
+
+The suspend, unsuspend and cancel methods update the database, but not the
+current object. This is probably a bug as it's unexpected and
+counterintuitive.
+
+radius_usergroup_selector? putting web ui components in here? they should
+probably live somewhere else...
+
+=head1 SEE ALSO
+
+L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
+export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
+L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
+L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::svc_acct_pop;
+
+use strict;
+use vars qw( @ISA @EXPORT_OK @svc_acct_pop %svc_acct_pop );
+use FS::Record qw( qsearch qsearchs );
+
+@ISA = qw( FS::Record Exporter );
+@EXPORT_OK = qw( popselector );
+
+=head1 NAME
+
+FS::svc_acct_pop - Object methods for svc_acct_pop records
+
+=head1 SYNOPSIS
+
+ use FS::svc_acct_pop;
+
+ $record = new FS::svc_acct_pop \%hash;
+ $record = new FS::svc_acct_pop { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $html = FS::svc_acct_pop::popselector( $popnum, $state );
+
+=head1 DESCRIPTION
+
+An FS::svc_acct object represents an point of presence. FS::svc_acct_pop
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item popnum - primary key (assigned automatically for new accounts)
+
+=item city
+
+=item state
+
+=item ac - area code
+
+=item exch - exchange
+
+=item loc - rest of number
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new point of presence (if only it were that easy!). To add the
+point of presence to the database, see L<"insert">.
+
+=cut
+
+sub table { 'svc_acct_pop'; }
+
+=item insert
+
+Adds this point of presence to the database. If there is an error, returns the
+error, otherwise returns false.
+
+=item delete
+
+Removes this point of presence from the database.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid point of presence. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ $self->ut_numbern('popnum')
+ or $self->ut_text('city')
+ or $self->ut_text('state')
+ or $self->ut_number('ac')
+ or $self->ut_number('exch')
+ or $self->ut_numbern('loc')
+ ;
+
+}
+
+=item text
+
+Returns:
+
+"$city, $state ($ac)/$exch"
+
+=cut
+
+sub text {
+ my $self = shift;
+ $self->city. ', '. $self->state.
+ ' ('. $self->ac. ')/'. $self->exch. '-'. $self->loc;
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item popselector [ POPNUM [ STATE ] ]
+
+=cut
+
+#horrible false laziness with signup.cgi (pull special-case for 0 & 1
+# pop code out from signup.cgi??)
+sub popselector {
+ my( $popnum, $state ) = @_;
+
+ unless ( @svc_acct_pop ) { #cache pop list
+ @svc_acct_pop = qsearch('svc_acct_pop', {} );
+ %svc_acct_pop = ();
+ push @{$svc_acct_pop{$_->state}}, $_ foreach @svc_acct_pop;
+ }
+
+ my $text = <<END;
+ <SCRIPT>
+ function opt(what,href,text) {
+ var optionName = new Option(text, href, false, false)
+ var length = what.length;
+ what.options[length] = optionName;
+ }
+
+ function popstate_changed(what) {
+ state = what.options[what.selectedIndex].text;
+ for (var i = what.form.popnum.length;i > 0;i--)
+ what.form.popnum.options[i] = null;
+ what.form.popnum.options[0] = new Option("", "", false, true);
+END
+
+ foreach my $popstate ( sort { $a cmp $b } keys %svc_acct_pop ) {
+ $text .= "\nif ( state == \"$popstate\" ) {\n";
+
+ foreach my $pop ( @{$svc_acct_pop{$popstate}}) {
+ my $o_popnum = $pop->popnum;
+ my $poptext = $pop->text;
+ $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n"
+ }
+ $text .= "}\n";
+ }
+
+ $text .= "}\n</SCRIPT>\n";
+
+ $text .=
+ qq!<SELECT NAME="popstate" SIZE=1 onChange="popstate_changed(this)">!.
+ qq!<OPTION> !;
+ $text .= "<OPTION>$_" foreach sort { $a cmp $b } keys %svc_acct_pop;
+ $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD><TD>';
+
+ $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !;
+ foreach my $pop ( @svc_acct_pop ) {
+ $text .= qq!<OPTION VALUE="!. $pop->popnum. '"'.
+ ( ( $popnum && $pop->popnum == $popnum ) ? ' SELECTED' : '' ). ">".
+ $pop->text;
+ }
+ $text .= '</SELECT>';
+
+ $text;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_acct_pop.pm,v 1.7 2002-04-10 13:42:48 ivan Exp $
+
+=head1 BUGS
+
+It should be renamed to part_pop.
+
+popselector? putting web ui components in here? they should probably live
+somewhere else...
+
+popselector: pull special-case for 0 & 1 pop code out from signup.cgi
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::svc_acct>, L<FS::part_pop_local>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::svc_acct_sm;
+
+use strict;
+use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines );
+use FS::Record qw( fields qsearch qsearchs );
+use FS::svc_Common;
+use FS::cust_svc;
+use Net::SSH qw(ssh);
+use FS::Conf;
+use FS::svc_acct;
+use FS::svc_domain;
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+#$FS::UID::callback{'FS::svc_acct_sm'} = sub {
+# $conf = new FS::Conf;
+# $shellmachine = $conf->exists('qmailmachines')
+# ? $conf->config('shellmachine')
+# : '';
+#};
+
+=head1 NAME
+
+FS::svc_acct_sm - Object methods for svc_acct_sm records
+
+=head1 SYNOPSIS
+
+ use FS::svc_acct_sm;
+
+ $record = new FS::svc_acct_sm \%hash;
+ $record = new FS::svc_acct_sm { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+=head1 WARNING
+
+FS::svc_acct_sm is B<depreciated>. This class is only included for migration
+purposes. See L<FS::svc_forward>.
+
+=head1 DESCRIPTION
+
+An FS::svc_acct_sm object represents a virtual mail alias. FS::svc_acct_sm
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key (assigned automatcially for new accounts)
+
+=item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>)
+
+=item domuid - uid of the target account (see L<FS::svc_acct>)
+
+=item domuser - virtual username
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new virtual mail alias. To add the virtual mail alias to the
+database, see L<"insert">.
+
+=cut
+
+sub table { 'svc_acct_sm'; }
+
+=item insert
+
+Adds this virtual mail alias to the database. If there is an error, returns
+the error, otherwise returns false.
+
+The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+ #If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines
+ #exist, and domuser is `*' (meaning a catch-all mailbox), the command:
+ #
+ # [ -e $dir/.qmail-$qdomain-default ] || {
+ # touch $dir/.qmail-$qdomain-default;
+ # chown $uid:$gid $dir/.qmail-$qdomain-default;
+ # }
+ #
+ #is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
+ #This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ $error=$self->check;
+ return $error if $error;
+
+ return "Domain username (domuser) in use for this domain (domsvc)"
+ if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser,
+ 'domsvc' => $self->domsvc,
+ } );
+
+ return "First domain username (domuser) for domain (domsvc) must be " .
+ qq='*' (catch-all)!=
+ if $self->domuser ne '*'
+ && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } )
+ && ! $conf->exists('maildisablecatchall');
+
+ $error = $self->SUPER::insert;
+ return $error if $error;
+
+ #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
+ #my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } );
+ #my ( $uid, $gid, $dir, $domain ) = (
+ # $svc_acct->uid,
+ # $svc_acct->gid,
+ # $svc_acct->dir,
+ # $svc_domain->domain,
+ #);
+ #my $qdomain = $domain;
+ #$qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
+ #ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
+ # if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
+
+ ''; #no error
+
+}
+
+=item delete
+
+Deletes this virtual mail alias 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.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ return "Domain username (domuser) in use for this domain (domsvc)"
+ if ( $old->domuser ne $new->domuser
+ || $old->domsvc != $new->domsvc
+ ) && qsearchs('svc_acct_sm',{
+ 'domuser'=> $new->domuser,
+ 'domsvc' => $new->domsvc,
+ } )
+ ;
+
+ $new->SUPER::replace($old);
+
+}
+
+=item suspend
+
+Just returns false (no error) for now.
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item unsuspend
+
+Just returns false (no error) for now.
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+Just returns false (no error) for now.
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid virtual mail alias. If there is
+an error, returns the error, otherwise returns false. Called by the insert and
+replace methods.
+
+Sets any fixed values; see L<FS::part_svc>.
+
+=cut
+
+sub check {
+ my $self = shift;
+ my $error;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ #my $part_svc = $x;
+
+ my($recref) = $self->hashref;
+
+ $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
+ or return "Illegal domain username (domuser)";
+ $recref->{domuser} = $1;
+
+ $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
+ $recref->{domsvc} = $1;
+ my($svc_domain);
+ return "Unknown domsvc" unless
+ $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
+
+ $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
+ $recref->{domuid} = $1;
+ my($svc_acct);
+ return "Unknown uid" unless
+ $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $
+
+=head1 BUGS
+
+The remote commands should be configurable.
+
+The $recref stuff in sub check should be cleaned up.
+
+=head1 SEE ALSO
+
+L<FS::svc_forward>
+
+L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
+L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::svc_domain;
+
+use strict;
+use vars qw( @ISA $whois_hack $conf $smtpmachine
+ @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine
+ $soarefresh $soaretry $qshellmachine $nossh_hack
+);
+use Carp;
+use Mail::Internet 1.44;
+use Mail::Header;
+use Date::Format;
+use Net::Whois 1.0;
+use Net::SSH;
+use FS::Record qw(fields qsearch qsearchs dbh);
+use FS::Conf;
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::cust_pkg;
+use FS::cust_main;
+use FS::domain_record;
+use FS::queue;
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::domain'} = sub {
+ $conf = new FS::Conf;
+
+ $smtpmachine = $conf->config('smtpmachine');
+
+ @defaultrecords = $conf->config('defaultrecords');
+ $soadefaultttl = $conf->config('soadefaultttl');
+ $soaemail = $conf->config('soaemail');
+ $soaexpire = $conf->config('soaexpire');
+ $soamachine = $conf->config('soamachine');
+ $soarefresh = $conf->config('soarefresh');
+ $soaretry = $conf->config('soaretry');
+
+ $qshellmachine = $conf->exists('qmailmachines')
+ ? $conf->config('shellmachine')
+ : '';
+};
+
+=head1 NAME
+
+FS::svc_domain - Object methods for svc_domain records
+
+=head1 SYNOPSIS
+
+ use FS::svc_domain;
+
+ $record = new FS::svc_domain \%hash;
+ $record = new FS::svc_domain { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+=head1 DESCRIPTION
+
+An FS::svc_domain object represents a domain. FS::svc_domain inherits from
+FS::svc_Common. The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key (assigned automatically for new accounts)
+
+=item domain
+
+=item catchall - optional svcnum of an svc_acct record, designating an email catchall account.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new domain. To add the domain to the database, see L<"insert">.
+
+=cut
+
+sub table { 'svc_domain'; }
+
+=item insert
+
+Adds this domain to the database. If there is an error, returns the error,
+otherwise returns false.
+
+The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+The additional field I<action> should be set to I<N> for new domains or I<M>
+for transfers.
+
+A registration or transfer email will be submitted unless
+$FS::svc_domain::whois_hack is true.
+
+The additional field I<email> can be used to manually set the admin contact
+email address on this email. Otherwise, the svc_acct records for this package
+(see L<FS::cust_pkg>) are searched. If there is exactly one svc_acct record
+in the same package, it is automatically used. Otherwise an error is returned.
+
+If any I<soamachine> configuration file exists, an SOA record is added to
+the domain_record table (see <FS::domain_record>).
+
+If any records are defined in the I<defaultrecords> configuration file,
+appropriate records are added to the domain_record table (see
+L<FS::domain_record>).
+
+If a machine is defined in the I<shellmachine> configuration value, the
+I<qmailmachines> configuration file exists, and the I<catchall> field points
+to an an account with a home directory (see L<FS::svc_acct>), the command:
+
+ [ -e $dir/.qmail-$qdomain-defualt ] || {
+ touch $dir/.qmail-$qdomain-default;
+ chown $uid:$gid $dir/.qmail-$qdomain-default;
+ }
+
+is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
+This behaviour can be supressed by setting $FS::svc_domain::nossh_hack true.
+
+a machine is defined
+in the
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $self->check;
+ return $error if $error;
+
+ return "Domain in use (here)"
+ if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
+
+ my $whois = $self->whois;
+ if ( $self->action eq "N" && ! $whois_hack && $whois ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Domain in use (see whois)";
+ }
+ if ( $self->action eq "M" && ! $whois ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Domain not found (see whois)";
+ }
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $self->submit_internic unless $whois_hack;
+
+ if ( $soamachine ) {
+ my $soa = new FS::domain_record {
+ 'svcnum' => $self->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => 'SOA',
+ 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%d", time). "00 ".
+ "$soarefresh $soaretry $soaexpire $soadefaultttl )"
+ };
+ $error = $soa->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "couldn't insert SOA record for new domain: $error";
+ }
+
+ foreach my $record ( @defaultrecords ) {
+ my($zone,$af,$type,$data) = split(/\s+/,$record,4);
+ my $domain_record = new FS::domain_record {
+ 'svcnum' => $self->svcnum,
+ 'reczone' => $zone,
+ 'recaf' => $af,
+ 'rectype' => $type,
+ 'recdata' => $data,
+ };
+ my $error = $domain_record->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "couldn't insert record for new domain: $error";
+ }
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ if ( $qshellmachine && $self->catchall && ! $nossh_hack ) {
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } )
+ or warn "WARNING: inserted unknown catchall: ". $self->catchall;
+ if ( $svc_acct && $svc_acct->dir ) {
+ my $qdomain = $self->domain;
+ $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
+ my ( $uid, $gid, $dir ) = (
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->dir,
+ );
+
+ my $queue = new FS::queue {
+ 'svcnum' => $self->svcnum,
+ 'job' => 'Net::SSH::ssh_cmd',
+ };
+ $error = $queue->insert("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }" );
+
+ }
+ }
+
+ ''; #no error
+}
+
+=item delete
+
+Deletes this domain 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.
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ return "Can't delete a domain which has accounts!"
+ if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } );
+
+ return "Can't delete a domain with (svc_acct_sm) mail aliases!"
+ if defined( $FS::Record::dbdef->table('svc_acct_sm') )
+ && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } );
+
+ return "Can't delete a domain with (domain_record) zone entries!"
+ if qsearch('domain_record', { 'svcnum' => $self->svcnum } );
+
+ $self->SUPER::delete;
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ return "Can't change domain - reorder."
+ if $old->getfield('domain') ne $new->getfield('domain');
+
+ $new->SUPER::replace($old);
+
+}
+
+=item suspend
+
+Just returns false (no error) for now.
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item unsuspend
+
+Just returns false (no error) for now.
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+Just returns false (no error) for now.
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid domain. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+Sets any fixed values; see L<FS::part_svc>.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ #my $part_svc = $x;
+
+ my $error = $self->ut_numbern('svcnum')
+ || $self->ut_numbern('catchall')
+ ;
+ return $error if $error;
+
+ #hmm
+ my $pkgnum;
+ if ( $self->svcnum ) {
+ my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
+ $pkgnum = $cust_svc->pkgnum;
+ } else {
+ $pkgnum = $self->pkgnum;
+ }
+
+ my($recref) = $self->hashref;
+
+ unless ( $whois_hack ) {
+ unless ( $self->email ) { #find out an email address
+ my @svc_acct;
+ foreach ( qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ) ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $_->svcnum } );
+ push @svc_acct, $svc_acct if $svc_acct;
+ }
+
+ if ( scalar(@svc_acct) == 0 ) {
+ return "Must order an account in package ". $pkgnum. " first";
+ } elsif ( scalar(@svc_acct) > 1 ) {
+ return "More than one account in package ". $pkgnum. ": specify admin contact email";
+ } else {
+ $self->email($svc_acct[0]->email );
+ }
+ }
+ }
+
+ #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
+ if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) {
+ $recref->{domain} = "$1.$2";
+ # hmmmmmmmm.
+ } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) {
+ $recref->{domain} = $1;
+ } else {
+ return "Illegal domain ". $recref->{domain}.
+ " (or unknown registry - try \$whois_hack)";
+ }
+
+ $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
+ $recref->{action} = $1;
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } );
+ return "Unknown catchall" unless $svc_acct || ! $recref->{catchall};
+
+ $self->ut_textn('purpose');
+
+}
+
+=item whois
+
+Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or
+undef if the domain is not found in whois.
+
+(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.)
+
+=cut
+
+sub whois {
+ $whois_hack or new Net::Whois::Domain $_[0]->domain;
+}
+
+=item _whois
+
+Depriciated.
+
+=cut
+
+sub _whois {
+ die "_whois depriciated";
+}
+
+=item submit_internic
+
+Submits a registration email for this domain.
+
+=cut
+
+sub submit_internic {
+ #my $self = shift;
+ carp "submit_internic depreciated";
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_domain.pm,v 1.28 2002-05-18 09:51:30 ivan Exp $
+
+=head1 BUGS
+
+All BIND/DNS fields should be included (and exported).
+
+Delete doesn't send a registration template.
+
+All registries should be supported.
+
+Should change action to a real field.
+
+The $recref stuff in sub check should be cleaned up.
+
+=head1 SEE ALSO
+
+L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
+L<FS::part_svc>, L<FS::cust_pkg>, L<Net::Whois>, L<ssh>,
+L<dot-qmail>, schema.html from the base documentation, config.html from the
+base documentation.
+
+=cut
+
+1;
+
+
--- /dev/null
+package FS::svc_forward;
+
+use strict;
+use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines
+ @vpopmailmachines );
+use Net::SSH qw(ssh);
+use FS::Conf;
+use FS::Record qw( fields qsearch qsearchs dbh );
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::svc_domain;
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::svc_forward'} = sub {
+ $conf = new FS::Conf;
+ if ( $conf->exists('qmailmachines') ) {
+ $shellmachine = $conf->config('shellmachine')
+ } else {
+ $shellmachine = '';
+ }
+ if ( $conf->exists('vpopmailmachines') ) {
+ @vpopmailmachines = $conf->config('vpopmailmachines');
+ } else {
+ @vpopmailmachines = ();
+ }
+};
+
+=head1 NAME
+
+FS::svc_forward - Object methods for svc_forward records
+
+=head1 SYNOPSIS
+
+ use FS::svc_forward;
+
+ $record = new FS::svc_forward \%hash;
+ $record = new FS::svc_forward { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+=head1 DESCRIPTION
+
+An FS::svc_forward object represents a mail forwarding alias. FS::svc_forward
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key (assigned automatcially for new accounts)
+
+=item srcsvc - svcnum of the source of the forward (see L<FS::svc_acct>)
+
+=item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>)
+
+=item dst - foreign destination (email address) - forward not local to freeside
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new mail forwarding alias. To add the mail forwarding alias to the
+database, see L<"insert">.
+
+=cut
+
+sub table { 'svc_forward'; }
+
+=item insert
+
+Adds this mail forwarding alias to the database. If there is an error, returns
+the error, otherwise returns false.
+
+The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+If the configuration value (see L<FS::Conf>) vpopmailmachines exists, then
+the command:
+
+ [ -d $vpopdir/domains/$domain/$source ] && {
+ echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail
+ chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail
+ }
+
+is executed on each vpopmailmachine via ssh (see the vpopmail documentation).
+This behaviour can be supressed by setting $FS::svc_forward::nossh_hack true.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $error = $self->check;
+ return $error if $error;
+
+ $error = $self->SUPER::insert;
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } );
+ my $username = $svc_acct->username;
+ my $domain = $svc_acct->domain;
+ my $destination;
+ if ($self->dstsvc) {
+ $destination = $self->dstsvc_acct->email;
+ } else {
+ $destination = $self->dst;
+ }
+
+ foreach my $vpopmailmachine ( @vpopmailmachines ) {
+ my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine);
+ my $queue = new FS::queue {
+ 'svcnum' => $self->svcnum,
+ 'job' => 'Net::SSH::ssh_cmd',
+ };
+ # should be neater
+ my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }")
+ unless $nossh_hack;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+
+}
+
+=item delete
+
+Deletes this mail forwarding alias 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.
+
+If the configuration value vpopmailmachines exists, then the command:
+
+ { sed -e '/^$destination/d' <
+ $vpopdir/domains/$srcdomain/$srcusername/.qmail >
+ $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp;
+ mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp
+ $vpopdir/domains/$srcdomain/$srcusername/.qmail;
+ chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; }
+
+
+is executed on each vpopmailmachine via ssh. This behaviour can be supressed
+by setting $FS::svc_forward_nossh_hack true.
+
+=cut
+
+sub delete {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::Autocommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $svc_acct = $self->srcsvc_acct;
+ my $username = $svc_acct->username;
+ my $domain = $svc_acct->domain;
+ my $destination;
+ if ($self->dstsvc) {
+ $destination = $self->dstsvc_acct->email;
+ } else {
+ $destination = $self->dst;
+ }
+ foreach my $vpopmailmachine ( @vpopmailmachines ) {
+ my($machine, $vpopdir, $vpopuid, $vpopgid) =
+ split(/\s+/, $vpopmailmachine);
+ my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };
+ # should be neater
+ my $error = $queue->insert("root\@$machine",
+ "sed -e '/^$destination/d' " .
+ "< $vpopdir/domains/$domain/$username/.qmail" .
+ "> $vpopdir/domains/$domain/$username/.qmail.temp; " .
+ "mv $vpopdir/domains/$domain/$username/.qmail.temp " .
+ "$vpopdir/domains/$domain/$username/.qmail; " .
+ "chown $vpopuid.$vpopgid $vpopdir/domains/$domain/$username/.qmail;"
+ )
+ unless $nossh_hack;
+
+ if ($error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+If the configuration value vpopmailmachines exists, then the command:
+
+ { sed -e '/^$destination/d' <
+ $vpopdir/domains/$srcdomain/$srcusername/.qmail >
+ $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp;
+ mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp
+ $vpopdir/domains/$srcdomain/$srcusername/.qmail;
+ chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; }
+
+
+is executed on each vpopmailmachine via ssh. This behaviour can be supressed
+by setting $FS::svc_forward_nossh_hack true.
+
+Also, if the configuration value vpopmailmachines exists, then the command:
+
+ [ -d $vpopdir/domains/$domain/$source ] && {
+ echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail
+ chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail
+ }
+
+is executed on each vpopmailmachine via ssh. This behaviour can be supressed
+by setting $FS::svc_forward_nossh_hack true.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+
+ if ( $new->srcsvc != $old->srcsvc
+ && ( $new->dstsvc != $old->dstsvc
+ || ! $new->dstsvc && $new->dst ne $old->dst
+ )
+ ) {
+ return "Can't change both source and destination of a mail forward!"
+ }
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $new->SUPER::replace($old);
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $old_svc_acct = $old->srcsvc_acct;
+ my $old_username = $old_svc_acct->username;
+ my $old_domain = $old_svc_acct->domain;
+ my $destination;
+ if ($old->dstsvc) {
+ $destination = $old->dstsvc_acct->email;
+ } else {
+ $destination = $old->dst;
+ }
+ foreach my $vpopmailmachine ( @vpopmailmachines ) {
+ my($machine, $vpopdir, $vpopuid, $vpopgid) =
+ split(/\s+/, $vpopmailmachine);
+ my $queue = new FS::queue {
+ 'svcnum' => $new->svcnum,
+ 'job' => 'Net::SSH::ssh_cmd',
+ };
+ # should be neater
+ my $error = $queue->insert("root\@$machine",
+ "sed -e '/^$destination/d' " .
+ "< $vpopdir/domains/$old_domain/$old_username/.qmail" .
+ "> $vpopdir/domains/$old_domain/$old_username/.qmail.temp; " .
+ "mv $vpopdir/domains/$old_domain/$old_username/.qmail.temp " .
+ "$vpopdir/domains/$old_domain/$old_username/.qmail; " .
+ "chown $vpopuid.$vpopgid " .
+ "$vpopdir/domains/$old_domain/$old_username/.qmail;"
+ )
+ unless $nossh_hack;
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+
+ #false laziness with stuff in insert, should subroutine
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->srcsvc } );
+ my $username = $svc_acct->username;
+ my $domain = $svc_acct->domain;
+ if ($new->dstsvc) {
+ $destination = $new->dstsvc_acct->email;
+ } else {
+ $destination = $new->dst;
+ }
+
+ foreach my $vpopmailmachine ( @vpopmailmachines ) {
+ my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine);
+ my $queue = new FS::queue {
+ 'svcnum' => $new->svcnum,
+ 'job' => 'Net::SSH::ssh_cmd',
+ };
+ # should be neater
+ my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }")
+ unless $nossh_hack;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "queueing job (transaction rolled back): $error";
+ }
+ }
+ #end subroutinable bits
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
+=item suspend
+
+Just returns false (no error) for now.
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item unsuspend
+
+Just returns false (no error) for now.
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+Just returns false (no error) for now.
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid mail forwarding alias. If there
+is an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+Sets any fixed values; see L<FS::part_svc>.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ #my $part_svc = $x;
+
+ my $error = $self->ut_numbern('svcnum')
+ || $self->ut_number('srcsvc')
+ || $self->ut_numbern('dstsvc')
+ ;
+ return $error if $error;
+
+ return "Unknown srcsvc" unless $self->srcsvc_acct;
+
+ return "Both dstsvc and dst were defined; one one can be specified"
+ if $self->dstsvc && $self->dst;
+
+ return "one of dstsvc or dst is required"
+ unless $self->dstsvc || $self->dst;
+
+ #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc;
+ return "Unknown dstsvc"
+ unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
+ || ! $self->dstsvc;
+
+
+ if ( $self->dst ) {
+ $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/
+ or return "Illegal dst: ". $self->dst;
+ $self->dst("$1\@$2");
+ } else {
+ $self->dst('');
+ }
+
+ ''; #no error
+}
+
+=item srcsvc_acct
+
+Returns the FS::svc_acct object referenced by the srcsvc column.
+
+=cut
+
+sub srcsvc_acct {
+ my $self = shift;
+ qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
+}
+
+=item dstsvc_acct
+
+Returns the FS::svc_acct object referenced by the srcsvc column, or false for
+forwards not local to freeside.
+
+=cut
+
+sub dstsvc_acct {
+ my $self = shift;
+ qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_forward.pm,v 1.11 2002-02-20 01:03:09 ivan Exp $
+
+=head1 BUGS
+
+The remote commands should be configurable.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
+L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
+schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::svc_www;
+
+use strict;
+use vars qw(@ISA $conf $apacheroot $apachemachine $apacheip $nossh_hack );
+#use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearchs dbh );
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::domain_record;
+use FS::svc_acct;
+use FS::svc_domain;
+use Net::SSH qw(ssh);
+
+@ISA = qw( FS::svc_Common );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::svc_www'} = sub {
+ $conf = new FS::Conf;
+ $apacheroot = $conf->config('apacheroot');
+ $apachemachine = $conf->config('apachemachine');
+ $apacheip = $conf->config('apacheip');
+};
+
+=head1 NAME
+
+FS::svc_www - Object methods for svc_www records
+
+=head1 SYNOPSIS
+
+ use FS::svc_www;
+
+ $record = new FS::svc_www \%hash;
+ $record = new FS::svc_www { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+=head1 DESCRIPTION
+
+An FS::svc_www object represents an web virtual host. FS::svc_www inherits
+from FS::svc_Common. The following fields are currently supported:
+
+=over 4
+
+=item svcnum - primary key
+
+=item recnum - DNS `A' record corresponding to this web virtual host. (see L<FS::domain_record>)
+
+=item usersvc - account (see L<FS::svc_acct>) corresponding to this web virtual host.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new web virtual host. To add the record to the database, see
+L<"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 I<hash> method.
+
+=cut
+
+sub table { 'svc_www'; }
+
+=item 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 L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+If the configuration values (see L<FS::Conf>) I<apachemachine>, and
+I<apacheroot> exist, the command:
+
+ mkdir $apacheroot/$zone;
+ chown $username $apacheroot/$zone;
+ ln -s $apacheroot/$zone $homedir/$zone
+
+I<$zone> is the DNS A record pointed to by I<recnum>
+I<$username> is the username pointed to by I<usersvc>
+I<$homedir> is that user's home directory
+
+is executed on I<apachemachine> via ssh. This behaviour can be surpressed by
+setting $FS::svc_www::nossh_hack true.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
+ if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) {
+ my( $reczone, $domain_svcnum ) = ( $1, $2 );
+ unless ( $apacheip ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Configuration option apacheip not set; can't autocreate A record";
+ #"for $reczone". $svc_domain->domain;
+ }
+ my $domain_record = new FS::domain_record {
+ 'svcnum' => $domain_svcnum,
+ 'reczone' => $reczone,
+ 'recaf' => 'IN',
+ 'rectype' => 'A',
+ 'recdata' => $apacheip,
+ };
+ $error = $domain_record->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $self->recnum($domain_record->recnum);
+ }
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } ); # or die ?
+ my $zone = $domain_record->reczone;
+ # or die ?
+ unless ( $zone =~ /\.$/ ) {
+ my $dom_svcnum = $domain_record->svcnum;
+ my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } );
+ # or die ?
+ $zone .= $svc_domain->domain;
+ }
+
+ my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
+ # or die ?
+ my $username = $svc_acct->username;
+ # or die ?
+ my $homedir = $svc_acct->dir;
+ # or die ?
+
+ if ( $apachemachine
+ && $apacheroot
+ && $zone
+ && $username
+ && $homedir
+ && ! $nossh_hack
+ ) {
+ ssh("root\@$apachemachine",
+ "mkdir $apacheroot/$zone; ".
+ "chown $username $apacheroot/$zone; ".
+ "ln -s $apacheroot/$zone $homedir/$zone"
+ );
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $error;
+
+ $error = $self->SUPER::delete;
+ return $error if $error;
+
+ '';
+}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ $error = $new->SUPER::replace($old);
+ return $error if $error;
+
+ '';
+}
+
+=item suspend
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item unsuspend
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid web virtual host. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and repalce methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ #my $part_svc = $x;
+
+ my $error =
+ $self->ut_numbern('svcnum')
+# || $self->ut_number('recnum')
+ || $self->ut_number('usersvc')
+ ;
+ return $error if $error;
+
+ if ( $self->recnum =~ /^(\d+)$/ ) {
+
+ $self->recnum($1);
+ return "Unknown recnum: ". $self->recnum
+ unless qsearchs('domain_record', { 'recnum' => $self->recnum } );
+
+ } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
+
+ my( $reczone, $domain ) = ( $1, $2 );
+
+ my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } )
+ or return "unknown domain $domain (recnum $1.$2)";
+
+ my $domain_record = qsearchs( 'domain_record', {
+ 'reczone' => $reczone,
+ 'svcnum' => $svc_domain->svcnum,
+ });
+
+ if ( $domain_record ) {
+ $self->recnum($domain_record->recnum);
+ } else {
+ #insert will create it
+ #$self->recnum("$reczone.$domain");
+ $self->recnum("$reczone.". $svc_domain->svcnum);
+ }
+
+ } else {
+ return "Illegal recnum: ". $self->recnum;
+ }
+
+ return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc
+ unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
+
+ ''; #no error
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::svc_Common>, L<FS::Record>, L<FS::domain_record>, L<FS::cust_svc>,
+L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::type_pkgs;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs );
+use FS::agent_type;
+use FS::part_pkg;
+
+@ISA = qw( FS::Record );
+
+=head1 NAME
+
+FS::type_pkgs - Object methods for type_pkgs records
+
+=head1 SYNOPSIS
+
+ use FS::type_pkgs;
+
+ $record = new FS::type_pkgs \%hash;
+ $record = new FS::type_pkgs { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::type_pkgs record links an agent type (see L<FS::agent_type>) to a
+billing item definition (see L<FS::part_pkg>). FS::type_pkgs inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item typenum - Agent type, see L<FS::agent_type>
+
+=item pkgpart - Billing item definition, see L<FS::part_pkg>
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Create a new record. To add the record to the database, see L<"insert">.
+
+=cut
+
+sub table { 'type_pkgs'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Deletes this record from the database. If there is an error, returns the
+error, otherwise returns false.
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid record. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_number('typenum')
+ || $self->ut_number('pkgpart')
+ ;
+ return $error if $error;
+
+ return "Unknown typenum"
+ unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
+
+ return "Unknown pkgpart"
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: type_pkgs.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::agent_type>, L<FS::part_pkgs>, schema.html from the base
+documentation.
+
+=cut
+
+1;
+
--- /dev/null
+Changes
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+bin/freeside-bill
+bin/freeside-daily
+bin/freeside-email
+bin/freeside-queued
+bin/freeside-apply-credits
+bin/freeside-adduser
+bin/freeside-setinvoice
+bin/freeside-overdue
+bin/freeside-receivables-report
+bin/freeside-tax-report
+bin/freeside-cc-receipts-report
+bin/freeside-credit-report
+bin/freeside-expiration-alerter
+FS.pm
+FS/CGI.pm
+FS/Conf.pm
+FS/ConfItem.pm
+FS/Record.pm
+FS/SearchCache.pm
+FS/UI/Base.pm
+FS/UI/CGI.pm
+FS/UI/Gtk.pm
+FS/UI/agent.pm
+FS/UID.pm
+FS/Msgcat.pm
+FS/agent.pm
+FS/agent_type.pm
+FS/cust_bill.pm
+FS/cust_bill_pkg.pm
+FS/cust_credit.pm
+FS/cust_credit_bill.pm
+FS/cust_main.pm
+FS/cust_main_county.pm
+FS/cust_main_invoice.pm
+FS/cust_pay.pm
+FS/cust_bill_event.pm
+FS/cust_bill_pay.pm
+FS/cust_pay_batch.pm
+FS/cust_pkg.pm
+FS/cust_refund.pm
+FS/cust_credit_refund.pm
+FS/cust_svc.pm
+FS/part_bill_event.pm
+FS/export_svc.pm
+FS/part_export.pm
+FS/part_export_option.pm
+FS/part_export/bsdshell.pm
+FS/part_export/cp.pm
+FS/part_export/cyrus.pm
+FS/part_export/infostreet.pm
+FS/part_export/shellcommands.pm
+FS/part_export/sqlradius.pm
+FS/part_export/textradius.pm
+FS/part_export/vpopmail.pm
+FS/part_pkg.pm
+FS/part_pop_local.pm
+FS/part_referral.pm
+FS/part_svc.pm
+FS/part_svc_column.pm
+FS/pkg_svc.pm
+FS/svc_Common.pm
+FS/svc_acct.pm
+FS/svc_acct_pop.pm
+FS/svc_acct_sm.pm
+FS/svc_domain.pm
+FS/type_pkgs.pm
+FS/nas.pm
+FS/port.pm
+FS/session.pm
+FS/domain_record.pm
+FS/prepay_credit.pm
+FS/svc_www.pm
+FS/svc_forward.pm
+FS/raddb.pm
+FS/radius_usergroup.pm
+FS/queue.pm
+FS/queue_arg.pm
+FS/queue_depend.pm
+FS/msgcat.pm
+FS/cust_tax_exempt.pm
+t/agent.t
+t/agent_type.t
+t/CGI.t
+t/Conf.t
+t/ConfItem.t
+t/Record.t
+t/UID.t
+t/Msgcat.t
+t/cust_bill.t
+t/cust_bill_event.t
+t/cust_bill_pay.t
+t/cust_bill_pkg.t
+t/cust_credit.t
+t/cust_credit_bill.t
+t/cust_credit_refund.t
+t/cust_main.t
+t/cust_main_county.t
+t/cust_main_invoice.t
+t/cust_pay.t
+t/cust_pay_batch.t
+t/cust_pkg.t
+t/cust_refund.t
+t/cust_svc.t
+t/domain_record.t
+t/nas.t
+t/part_bill_event.t
+t/export_svc.t
+t/part_export.t
+t/part_export_option.t
+t/part_export-bsdshell.t
+t/part_export-cp.t
+t/part_export-cyrus.t
+t/part_export-infostreet.t
+t/part_export-shellcommands.t
+t/part_export-sqlradius.t
+t/part_export-textradius.t
+t/part_export-vpopmail.t
+t/part_pkg.t
+t/part_pop_local.t
+t/part_referral.t
+t/part_svc.t
+t/part_svc_column.t
+t/pkg_svc.t
+t/port.t
+t/prepay_credit.t
+t/radius_usergroup.t
+t/session.t
+t/svc_acct.t
+t/svc_acct_pop.t
+t/svc_acct_sm.t
+t/svc_Common.t
+t/svc_domain.t
+t/svc_forward.t
+t/svc_www.t
+t/type_pkgs.t
+t/queue.t
+t/queue_arg.t
+t/msgcat.t
+t/raddb.t
+t/cust_tax_exempt.t
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'FS',
+ 'VERSION_FROM' => 'FS.pm', # finds $VERSION
+ 'EXE_FILES' => [ glob 'bin/*' ],
+);
--- /dev/null
+This is the Perl module section of Freeside.
+
+perl Makefile.PL
+make
+make test
+make install
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: freeside-adduser,v 1.4 2002-02-06 14:58:05 ivan Exp $
+
+use strict;
+use vars qw($opt_h $opt_c $opt_s);
+use Getopt::Std;
+
+my $FREESIDE_CONF = "/usr/local/etc/freeside";
+
+getopts("ch:s:");
+die &usage if $opt_c && ! $opt_h;
+my $user = shift or die &usage;
+
+if ( $opt_h ) {
+ my @args = ( 'htpasswd' );
+ push @args, '-c' if $opt_c;
+ push @args, $opt_h, $user;
+ system(@args) == 0 or die "htpasswd failed: $?";
+}
+
+my $secretfile = $opt_s || 'secrets';
+
+open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets")
+ or die "can't open $FREESIDE_CONF/mapsecrets: $!";
+print MAPSECRETS "$user $secretfile\n";
+close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!";
+
+sub usage {
+ die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username"
+}
+
+=head1 NAME
+
+freeside-adduser - Command line interface to add (freeside) users.
+
+=head1 SYNOPSIS
+
+ freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] username
+
+=head1 DESCRIPTION
+
+Adds a user to the Freeside billing system. This is for adding users (internal
+sales/tech folks) to the web interface, not for adding customer accounts.
+
+ -h: Also call htpasswd for this user with the given filename
+
+ -c: Passed to htpasswd
+
+ -s: Specify an alternate secret file
+
+=head1 SEE ALSO
+
+L<htpasswd>, base Freeside documentation
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw( $user $cust_main @customers );
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+
+$user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my @customers = qsearch('cust_main', {} );
+die "No customers" unless (scalar(@customers) > 0);
+
+foreach $cust_main (@customers) {
+ print "Applying credits for customer #". $cust_main->custnum;
+ $cust_main->apply_credits;
+}
+
+
+
--- /dev/null
+#!/usr/bin/perl -w
+# don't take any world-facing input
+#!/usr/bin/perl -Tw
+
+use strict;
+use Fcntl qw(:flock);
+use Date::Parse;
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_a $opt_c $opt_d $opt_p);
+getopts("acd:p");
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+my %bill_only = map { $_ => 1 } (
+ @ARGV ? @ARGV : ( map $_->custnum, qsearch('cust_main', {} ) )
+);
+
+#we're at now now (and later).
+my($time)= $opt_d ? str2time($opt_d) : $^T;
+
+# find packages w/ bill < time && cancel != '', and create corresponding
+# customer objects
+
+my($cust_main,%saw);
+foreach $cust_main (
+ map {
+ unless ( exists $saw{ $_->custnum } && defined $saw{ $_->custnum} ) {
+ $saw{ $_->custnum } = 0; # to avoid 'use of uninitialized value' errors
+ }
+ if (
+ ( $opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) )
+ && $bill_only{ $_->custnum }
+ && !$saw{ $_->custnum }++
+ ) {
+ qsearchs('cust_main',{'custnum'=> $_->custnum } );
+ } else {
+ ();
+ }
+ } ( qsearch('cust_pkg', { 'cancel' => '' }),
+ qsearch('cust_pkg', { 'cancel' => 0 }),
+ )
+) {
+
+ # and bill them
+
+ print "Billing customer #" . $cust_main->getfield('custnum') . "\n";
+
+ my($error);
+
+ $error=$cust_main->bill('time'=>$time);
+ warn "Error billing, customer #" . $cust_main->getfield('custnum') .
+ ":" . $error if $error;
+
+ if ($opt_p) {
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+ }
+
+ if ($opt_c) {
+ $error=$cust_main->collect( 'invoice_time' => $time);
+ warn "Error collecting from customer #" . $cust_main->custnum. ":$error"
+ if $error;
+
+ #sleep 1;
+ }
+
+}
+
+# subroutines
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ # Date::Parse
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-bill [ -c [ -p ] ] [ -d 'date' ] user [ custnum custnum ... ]\n";
+}
+
+=head1 NAME
+
+freeside-bill - Command line (crontab, script) interface to customer billing.
+
+=head1 SYNOPSIS
+
+ freeside-bill [ -c [ -p ] [ -a ] ] [ -d 'date' ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+This script is deprecated in 1.4.0. You should use freeside-daily instead.
+
+Bills customers. Searches for customers who are due for billing and calls
+the bill and collect methods of a cust_main object. See L<FS::cust_main>.
+
+ -c: Turn on collecting (you probably want this).
+
+ -p: Apply unapplied payments and credits before collecting (you probably want
+ this too)
+
+ -a: Call collect even if there isn't a new invoice (probably a bad idea for
+ daily use)
+
+ -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with,
+ but be careful.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+custnum: if one or more customer numbers are specified, only bills those
+customers. Otherwise, bills all customers.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<freeside-daily>, L<FS::cust_main>, config.html from the base documentation
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+
+use strict;
+use Date::Parse;
+use Time::Local;
+use Getopt::Std;
+use Text::Template;
+use Net::SMTP;
+use Mail::Header;
+use Mail::Internet;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_pay;
+use FS::cust_pay_batch;
+
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header);
+getopts("vpmef:s:"); #switches
+
+#we're at now now (and later).
+my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T;
+my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T;
+
+# Get the current month
+my ($ssec,$smin,$shour,$smday,$smon,$syear) =
+ (localtime($_startdate) )[0,1,2,3,4,5];
+$smon++;
+$syear += 1900;
+
+# Get the current month
+my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) =
+ (localtime($_finishdate) )[0,1,2,3,4,5];
+$fmon++;
+$fyear += 1900;
+
+# Login to the database
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# Get the needed configuration files
+my $conf = new FS::Conf;
+my $lpr = $conf->config('lpr');
+my $email = $conf->config('email');
+my $smtpmachine = $conf->config('smtpmachine');
+my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') :
+ 'postmaster';
+my @report_template = $conf->config('report_template')
+ or die "cannot load config file report_template";
+$report_lines = 0;
+foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/
+ /report_lines\((\d+)\)/;
+ $report_lines += $1;
+}
+die "no report_lines() functions in template?" unless $report_lines;
+$report_template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @report_template ],
+) or die "can't create new Text::Template object: $Text::Template::ERROR";
+
+
+my(@cust_pays)=qsearch('cust_pay',{});
+if (scalar(@cust_pays) == 0)
+{
+ exit 1;
+}
+
+# Open print and email pipes
+# $lpr and opt_p for printing
+# $email and opt_m for email
+
+if ($lpr && $main::opt_p)
+{
+ open(LPR, "|$lpr");
+}
+
+if ($email && $main::opt_m)
+{
+ $ENV{MAILADDRESS} = $mail_sender;
+ $header = new Mail::Header ( [
+ "From: Account Processor",
+ "To: $email",
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Subject: Credit Card Receipts",
+ ] );
+}
+
+my $uninvoiced = 0;
+my $total = 0;
+my $taxed = 0;
+my $untaxed = 0;
+my $total_tax = 0;
+
+# Now I can start looping
+foreach my $cust_pay (@cust_pays)
+{
+ my $_date = $cust_pay->getfield('_date');
+ my $invnum = $cust_pay->getfield('invnum');
+ my $paid = $cust_pay->getfield('paid');
+ my $payby = $cust_pay->getfield('payby');
+
+
+ if ($_date >= $_startdate && $_date <= $_finishdate && $payby =~ 'CARD') {
+ $total += $paid;
+
+ $uninvoiced += $cust_pay->unapplied;
+ my @cust_bill_pays = $cust_pay->cust_bill_pay;
+ foreach my $cust_bill_pay (@cust_bill_pays) {
+ my $invoice_amt =0;
+ my $invoice_tax =0;
+ my(@cust_bill_pkgs)= $cust_bill_pay->cust_bill->cust_bill_pkg;
+ foreach my $cust_bill_pkg (@cust_bill_pkgs) {
+
+ my $recur = $cust_bill_pkg->getfield('recur');
+ my $setup = $cust_bill_pkg->getfield('setup');
+ my $pkgnum = $cust_bill_pkg->getfield('pkgnum');
+
+ if ($pkgnum == 0) {
+ $invoice_tax += $recur;
+ $invoice_tax += $setup;
+ } else {
+ $invoice_amt += $recur;
+ $invoice_amt += $setup;
+ }
+
+ }
+
+ if ($invoice_tax > 0) {
+ if ($invoice_amt != $paid) {
+ # attempt to prorate partially paid invoices
+ $total_tax += $paid / ($invoice_amt + $invoice_tax) * $invoice_tax;
+ $taxed += $paid / ($invoice_amt + $invoice_tax) * $invoice_amt;
+ } else {
+ $total_tax += $invoice_tax;
+ $taxed += $invoice_amt;
+ }
+ } else {
+ $untaxed += $paid;
+ }
+
+ }
+
+ }
+
+}
+
+push @buf, sprintf(qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced);
+push @buf, sprintf(qq{%25s%14.2f\n}, "Untaxed", $untaxed);
+push @buf, sprintf(qq{%25s%14.2f\n}, "Taxed", $taxed);
+push @buf, sprintf(qq{%25s%14.2f\n}, "Tax", $total_tax);
+push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total);
+
+sub FS::cc_receipts_report::_template::report_lines {
+ my $lines = shift;
+ map {
+ scalar(@buf) ? shift @buf : '' ;
+ }
+ ( 1 .. $lines );
+}
+
+$FS::cc_receipts_report::_template::title = qq~CREDIT CARD RECEIPTS for period $smon/$smday/$syear through $fmon/$fmday/$fyear~;
+$FS::cc_receipts_report::_template::title = $opt_t if $opt_t;
+$FS::cc_receipts_report::_template::page = 1;
+$FS::cc_receipts_report::_template::date = $^T;
+$FS::cc_receipts_report::_template::date = $^T;
+$FS::cc_receipts_report::_template::fdate = $_finishdate;
+$FS::cc_receipts_report::_template::fdate = $_finishdate;
+$FS::cc_receipts_report::_template::sdate = $_startdate;
+$FS::cc_receipts_report::_template::sdate = $_startdate;
+$FS::cc_receipts_report::_template::total_pages =
+ int( scalar(@buf) / $report_lines);
+$FS::cc_receipts_report::_template::total_pages++ if scalar(@buf) % $report_lines;
+
+my @report;
+while (@buf) {
+ push @report, split("\n",
+ $report_template->fill_in( PACKAGE => 'FS::cc_receipts_report::_template' )
+ );
+ $FS::cc_receipts_report::_template::page++;
+}
+
+if ($opt_v) {
+ print map "$_\n", @report;
+}
+if($lpr && $opt_p)
+{
+ print LPR map "$_\n", @report;
+ print LPR "\f" if $opt_e;
+ close LPR || die "Could not close printer: $lpr\n";
+}
+if($email && $opt_m)
+{
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ (@report) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => "$smtpmachine" )
+ or die "can't send report to $email via $smtpmachine: $!";
+}
+
+
+# subroutines
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-cc-receipts-report [-v] [-p] [-e] user\n";
+}
+
+=head1 NAME
+
+freeside-cc-receipts-report - Prints or emails total credit card receipts in a given period.
+
+=head1 SYNOPSIS
+
+ freeside-cc-receipts-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user
+
+=head1 DESCRIPTION
+
+Prints or emails sales taxes invoiced in a given period.
+
+-v: Verbose - Prints records to STDOUT.
+
+-p: Print to printer lpr as found in the conf directory.
+
+-m: Email output to user found in the Conf email file.
+
+-e: Print a final form feed to the printer.
+
+-t: supply a title for the top of each page.
+
+-s: starting date for inclusion
+
+-f: final date for inclusion
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-cc-receipts-report,v 1.4 2002-03-07 19:50:23 jeff Exp $
+
+=head1 BUGS
+
+Yes..... Use at your own risk. No guarantees or warrantees of any
+kind apply to this program. Parts of this program are hacked from
+other GNU licensed software created mainly by Ivan Kohler.
+
+This is released under the GNU Public License. See www.gnu.org
+for more information regarding this license.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 AUTHOR
+
+Jeff Finucane <jeff@cmh.net>
+
+based on print-batch by Joel Griffiths <griff@aver-computer.com>
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+
+use strict;
+use Date::Parse;
+use Time::Local;
+use Getopt::Std;
+use Text::Template;
+use Net::SMTP;
+use Mail::Header;
+use Mail::Internet;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_credit;
+
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header);
+getopts("vpmef:s:"); #switches
+
+#we're at now now (and later).
+my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T;
+my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T;
+
+# Get the current month
+my ($ssec,$smin,$shour,$smday,$smon,$syear) =
+ (localtime($_startdate) )[0,1,2,3,4,5];
+$smon++;
+$syear += 1900;
+
+# Get the current month
+my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) =
+ (localtime($_finishdate) )[0,1,2,3,4,5];
+$fmon++;
+$fyear += 1900;
+
+# Login to the database
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# Get the needed configuration files
+my $conf = new FS::Conf;
+my $lpr = $conf->config('lpr');
+my $email = $conf->config('email');
+my $smtpmachine = $conf->config('smtpmachine');
+my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') :
+ 'postmaster';
+my @report_template = $conf->config('report_template')
+ or die "cannot load config file report_template";
+$report_lines = 0;
+foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/
+ /report_lines\((\d+)\)/;
+ $report_lines += $1;
+}
+die "no report_lines() functions in template?" unless $report_lines;
+$report_template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @report_template ],
+) or die "can't create new Text::Template object: $Text::Template::ERROR";
+
+
+my(@cust_credits)=qsearch('cust_credit',{});
+if (scalar(@cust_credits) == 0)
+{
+ exit 1;
+}
+
+# Open print and email pipes
+# $lpr and opt_p for printing
+# $email and opt_m for email
+
+if ($lpr && $main::opt_p)
+{
+ open(LPR, "|$lpr");
+}
+
+if ($email && $main::opt_m)
+{
+ $ENV{MAILADDRESS} = $mail_sender;
+ $header = new Mail::Header ( [
+ "From: Account Processor",
+ "To: $email",
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Subject: In House Credits",
+ ] );
+}
+
+my $uninvoiced = 0;
+my $total = 0;
+my $taxed = 0;
+my $untaxed = 0;
+my $total_tax = 0;
+
+# Now I can start looping
+foreach my $cust_credit (@cust_credits)
+{
+ my $_date = $cust_credit->getfield('_date');
+ my $amount = $cust_credit->getfield('amount');
+
+ if ($_date >= $_startdate && $_date <= $_finishdate) {
+ $total += $amount;
+ }
+}
+
+push @buf, sprintf(qq{\n%25s%14.2f\n}, "Credits Offered", $total);
+push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total);
+
+sub FS::credit_report::_template::report_lines {
+ my $lines = shift;
+ map {
+ scalar(@buf) ? shift @buf : '' ;
+ }
+ ( 1 .. $lines );
+}
+
+$FS::credit_report::_template::title = qq~IN HOUSE CREDITS for $smon/$smday/$syear through $fmon/$fmday/$fyear~;
+$FS::credit_report::_template::title = $opt_t if $opt_t;
+$FS::credit_report::_template::page = 1;
+$FS::credit_report::_template::date = $^T;
+$FS::credit_report::_template::date = $^T;
+$FS::credit_report::_template::fdate = $_finishdate;
+$FS::credit_report::_template::fdate = $_finishdate;
+$FS::credit_report::_template::sdate = $_startdate;
+$FS::credit_report::_template::sdate = $_startdate;
+$FS::credit_report::_template::total_pages =
+ int( scalar(@buf) / $report_lines);
+$FS::credit_report::_template::total_pages++ if scalar(@buf) % $report_lines;
+
+my @report;
+while (@buf) {
+ push @report, split("\n",
+ $report_template->fill_in( PACKAGE => 'FS::credit_report::_template' )
+ );
+ $FS::credit_report::_template::page++;
+}
+
+if ($opt_v) {
+ print map "$_\n", @report;
+}
+if($lpr && $opt_p)
+{
+ print LPR map "$_\n", @report;
+ print LPR "\f" if $opt_e;
+ close LPR || die "Could not close printer: $lpr\n";
+}
+if($email && $opt_m)
+{
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ (@report) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => "$smtpmachine" )
+ or die "can't send report to $email via $smtpmachine: $!";
+}
+
+
+# subroutines
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-credit-report [-v] [-p] [-e] user\n";
+}
+
+=head1 NAME
+
+freeside-credit-report - Prints or emails total credit memos in a given period.
+
+=head1 SYNOPSIS
+
+ freeside-credit-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user
+
+=head1 DESCRIPTION
+
+Prints or emails total credit memos in a given period.
+
+-v: Verbose - Prints records to STDOUT.
+
+-p: Print to printer lpr as found in the conf directory.
+
+-m: Email output to user found in the Conf email file.
+
+-e: Print a final form feed to the printer.
+
+-t: supply a title for the top of each page.
+
+-s: starting date for inclusion
+
+-f: final date for inclusion
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-credit-report,v 1.4 2002-03-07 19:50:24 jeff Exp $
+
+=head1 BUGS
+
+Yes..... Use at your own risk. No guarantees or warrantees of any
+kind apply to this program. Parts of this program are hacked from
+other GNU licensed software created mainly by Ivan Kohler.
+
+This is released under the GNU Public License. See www.gnu.org
+for more information regarding this license.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 AUTHOR
+
+Jeff Finucane <jeff@cmh.net>
+
+based on print-batch by Joel Griffiths <griff@aver-computer.com>
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Fcntl qw(:flock);
+use Date::Parse;
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_d $opt_v);
+getopts("d:v");
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+$FS::cust_main::Debug = 1 if $opt_v;
+
+my @cust_main = @ARGV
+ ? map { qsearchs('cust_main', { custnum => $_ } ) } @ARGV
+ : qsearch('cust_main', {} )
+;
+
+#we're at now now (and later).
+my($time)= $opt_d ? str2time($opt_d) : $^T;
+
+my($cust_main,%saw);
+foreach $cust_main ( @cust_main ) {
+
+ my $error;
+
+ $error = $cust_main->bill( 'time' => $time );
+ warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error;
+
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+
+ $error=$cust_main->collect( 'invoice_time' => $time );
+ warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error;
+
+}
+
+# subroutines
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ # Date::Parse
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n";
+}
+
+=head1 NAME
+
+freeside-daily - Run daily billing and invoice collection events.
+
+=head1 SYNOPSIS
+
+ freeside-daily [ -d 'date' ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+Bills customers and runs invoice collection events. Should be run from
+crontab daily.
+
+This script replaces freeside-bill from 1.3.1.
+
+Bills customers. Searches for customers who are due for billing and calls
+the bill and collect methods of a cust_main object. See L<FS::cust_main>.
+
+ -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with,
+ but be careful.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+custnum: if one or more customer numbers are specified, only bills those
+customers. Otherwise, bills all customers.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::Record qw(qsearch);
+use FS::svc_acct;
+
+&untaint_argv; #what it sounds like (eww)
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+my $conf = new FS::Conf;
+my $domain = $conf->config('domain');
+
+my @svc_acct = qsearch('svc_acct', {});
+my @usernames = map $_->username, @svc_acct;
+my @emails = map "$_\@$domain", @usernames;
+
+print join("\n", @emails), "\n";
+
+# subroutines
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ # Date::Parse
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-email user\n";
+}
+
+=head1 NAME
+
+freeside-email - Prints email addresses of all users on STDOUT
+
+=head1 SYNOPSIS
+
+ freeside-email user
+
+=head1 DESCRIPTION
+
+Prints the email addresses of all customers on STDOUT, separated by newlines.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-email,v 1.1 2001-05-15 07:52:34 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use Date::Format;
+use Time::Local;
+use Text::Template;
+use Getopt::Std;
+use Net::SMTP;
+use Mail::Header;
+use Mail::Internet;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+
+use vars qw($smtpmachine @body);
+
+#hush, perl!
+$FS::alerter::_template::first = "";
+$FS::alerter::_template::last = "";
+$FS::alerter::_template::company = "";
+$FS::alerter::_template::payby = "";
+$FS::alerter::_template::expdate = "";
+
+# Set the mail program and other variables
+my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available
+my $failure_recipient = "postmaster"; # or invoice_from if available
+my $warning_time = 30 * 24 * 60 * 60;
+my $urgent_time = 15 * 24 * 60 * 60;
+my $panic_time = 5 * 24 * 60 * 60;
+my $window_time = 24 * 60 * 60;
+
+&untaint_argv; #what it sounds like (eww)
+
+#we're at now now (and later).
+my($_date)= $^T;
+
+# Get the current month
+my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($_date) )[0,1,2,3,4,5];
+$mon++;
+
+# Login to the database
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# Get the needed configuration files
+my $conf = new FS::Conf;
+$smtpmachine = $conf->config('smtpmachine');
+$mail_sender = $conf->config('invoice_from')
+ if $conf->exists('invoice_from');
+$failure_recipient = $conf->config('invoice_from')
+ if $conf->exists('invoice_from');
+
+
+my(@customers)=qsearch('cust_main',{});
+if (scalar(@customers) == 0)
+{
+ exit 1;
+}
+
+# Prepare for sending email
+
+$ENV{MAILADDRESS} = $mail_sender;
+my $header = new Mail::Header ( [
+ "From: Account Processor",
+ "To: $failure_recipient",
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Subject: Unnotified Billing Arrangement Expirations",
+] );
+
+my @alerter_template = $conf->config('alerter_template')
+ or die "cannot load config file alerter_template";
+
+my $alerter = new Text::Template (TYPE => 'ARRAY', SOURCE => [ map "$_\n", @alerter_template ])
+ or die "can't create new Text::Template object: Text::Template::ERROR";
+$alerter->compile() or die "can't compile template: Text::Template::ERROR";
+
+# Now I can start looping
+foreach my $customer (@customers)
+{
+ my $custnum = $customer->getfield('custnum');
+ my $first = $customer->getfield('first');
+ my $last = $customer->getfield('last');
+ my $company = $customer->getfield('company');
+ my $payby = $customer->getfield('payby');
+ my $payinfo = $customer->getfield('payinfo');
+ my $paydate = $customer->getfield('paydate');
+ my $daytime = $customer->getfield('daytime');
+ my $night = $customer->getfield('night');
+
+ my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
+
+ my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
+
+ #credit cards expire at the end of the month/year of their exp date
+ if ($payby eq 'CARD') {
+ ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
+ $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
+ $expire_time--;
+ }
+
+ if (($expire_time < $_date + $warning_time &&
+ $expire_time > $_date + $warning_time - $window_time) ||
+ ($expire_time < $_date + $urgent_time &&
+ $expire_time > $_date + $urgent_time - $window_time) ||
+ ($expire_time < $_date + $panic_time &&
+ $expire_time > $_date + $panic_time - $window_time)) {
+
+
+
+ my @packages = $customer->ncancelled_pkgs;
+ if (scalar(@packages) != 0) {
+ my @invoicing_list = $customer->invoicing_list;
+ if ( grep { $_ ne 'POST' } @invoicing_list ) {
+ my $header = new Mail::Header ( [
+ "From: $mail_sender",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Billing Arrangement Expiration",
+ ] );
+ $FS::alerter::_template::first = $first;
+ $FS::alerter::_template::last = $last;
+ $FS::alerter::_template::company = $company;
+ if ($payby eq 'CARD') {
+ $FS::alerter::_template::payby = "credit card (" .
+ substr($payinfo, 0, 2) . "xxxxxxxxxx" .
+ substr($payinfo, -4) . ")";
+ }elsif ($payby eq 'COMP') {
+ $FS::alerter::_template::payby = "complimentary account";
+ }else{
+ $FS::alerter::_template::payby = "current method";
+ }
+ $FS::alerter::_template::expdate = $expire_time;
+
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or die "Can't send expiration email: $!";
+
+ } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
+ push @body, sprintf(qq{%5d %-32.32s %4s %10s %12s %12s},
+ $custnum,
+ $first . " " . $last . " " . $company,
+ $payby,
+ $paydate,
+ $daytime,
+ $night);
+ }
+ }
+ }
+}
+
+# Now I need to send EMAIL
+if (scalar(@body)) {
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ (@body) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or die "can't send alerter failure email to $failure_recipient".
+ " via server $smtpmachine with SMTP: $!";
+}
+
+# subroutines
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-expiration-alerter user\n";
+}
+
+=head1 NAME
+
+freeside-expiration-alerter - Emails notifications of credit card expirations.
+
+=head1 SYNOPSIS
+
+ freeside-expiration-alerter user
+
+=head1 DESCRIPTION
+
+Emails customers notice that their credit card or other billing arrangement
+is about to expire. Usually run as a cron job.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-expiration-alerter,v 1.3 2002-04-16 09:38:19 ivan Exp $
+
+=head1 BUGS
+
+Yes..... Use at your own risk. No guarantees or warrantees of any
+kind apply to this program. Parts of this program are hacked from
+other GNU licensed software created mainly by Ivan Kohler.
+
+This is released under the GNU Public License. See www.gnu.org
+for more information regarding this license.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 AUTHOR
+
+Jeff Finucane <jeff@cmh.net>
+
+=cut
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw( $days_to_pay $cust_main $cust_pkg
+ $cust_svc $svc_acct );
+use Getopt::Std;
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::Record qw(qsearch qsearchs);
+use FS::UID qw(adminsuidsetup);
+
+&untaint_argv;
+my %opt;
+getopts('ed:qpl:scbyoi', \%opt);
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+my $now = time; #eventually take a time option like freeside-bill
+my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($now) )[0,1,2,3,4,5];
+$mon++;
+$year += 1900;
+
+foreach $cust_main ( qsearch('cust_main',{} ) ) {
+
+ my ( $eyear, $emon, $eday ) = ( 2037, 12, 31 );
+ if ( $cust_main->paydate =~ /^(\d{4})\-(\d{1,2})\-(\d{1,2})$/
+ && $cust_main->payby eq 'BILL') {
+ ( $eyear, $emon, $eday ) = ( $1, $2, $3 );
+ }
+
+ if ( ( $opt{d}
+ && $cust_main->balance_date(time - $opt{d} * 86400) > 0
+ && qsearchs( 'cust_pkg', { 'custnum' => $cust_main->custnum,
+ 'susp' => "" } ) )
+ || ( $opt{e}
+ && $cust_main->payby eq 'BILL'
+ && ( $eyear < $year
+ || ( $eyear == $year && $emon < $mon ) ) )
+ ) {
+
+ unless ( $opt{q} ) {
+ print $cust_main->custnum, "\t",
+ $cust_main->last, "\t", $cust_main->first, "\t",
+ $cust_main->balance_date(time-$opt{d} * 86400);
+ }
+
+ if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) {
+ print "\n\tAdding postal invoicing" unless $opt{q};
+ my @invoicing_list = $cust_main->invoicing_list;
+ push @invoicing_list, 'POST';
+ $cust_main->invoicing_list(\@invoicing_list);
+ }
+
+ if ( $opt{l} ) {
+ print "\n\tCharging late fee of \$$opt{l}" unless $opt{q};
+ my $error = $cust_main->charge($opt{l}, 'Late fee');
+ # comment or plandata with info so we don't redo the same late fee every
+ # day
+ }
+
+ foreach $cust_pkg ( qsearch( 'cust_pkg',
+ { 'custnum' => $cust_main->custnum } ) ) {
+
+ if ($opt{s}) {
+ print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q};
+ $cust_pkg->suspend;
+ }
+
+ if ($opt{c}) {
+ print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q};
+ $cust_pkg->cancel;
+ }
+
+ }
+
+ if ( $opt{b} ) {
+ print "\n\tBilling" unless $opt{q};
+ my $error = $cust_main->bill('time'=>$now);
+ warn "Error billing, customer #" . $cust_main->custnum .
+ ":" . $error if $error;
+ }
+
+ if ( $opt{y} ) {
+ print "\n\tApplying outstanding payments and credits" unless $opt{q};
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+ }
+
+ if ( $opt{o} ) {
+ print "\n\tCollecting" unless $opt{q};
+ my $error = $cust_main->collect(
+ 'invoice_time' => $now,
+ 'batch_card' => $opt{i} ? 'no' : 'yes',
+ 'force_print' => 'yes',
+ );
+ warn "Error collecting from customer #" . $cust_main->custnum. ":$error"
+ if $error;
+ }
+
+ print "\n" unless $opt{q};
+
+ }
+
+}
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) {
+ $ARGV[$_] =~ /^([\w\-\/\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user\n";
+}
+
+
+=head1 NAME
+
+freeside-overdue - Perform actions on overdue and/or expired accounts.
+
+=head1 SYNOPSIS
+
+ freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user
+
+=head1 DESCRIPTION
+
+This script is deprecated in 1.4.0. You should use freeside-daily and invoice
+events instead.
+
+Performs actions on overdue and/or expired accounts.
+
+Selection options (at least one selection option is required):
+
+ -d: Customers with a balance due on invoices older than the supplied number
+ of days. Requires an integer argument.
+
+ -e: Customers with a billing expiration date in the past.
+
+Action options:
+
+ -q: Be quiet (by default, selected accounts are printed).
+
+ -p: Add postal invoicing to the relevant customers.
+
+ -l: Add a charge of the given amount to the relevant customers.
+
+ -s: Suspend accounts.
+
+ -c: Cancel accounts.
+
+ -b: Bill customers (create invoices)
+
+ -y: Apply unapplied payments and credits
+
+ -o: Collect from customers (charge cards, print invoices)
+
+ -i: real-time billing (as opposed to batch billing). only relevant
+ for credit cards.
+
+ user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 CRONTAB
+
+Example crontab entries:
+
+# suspend expired accounts
+20 4 * * * freeside-overdue -e -s user
+
+# quietly add postal invoicing to customers over 30 days past due
+20 4 * * * freeside-overdue -d 30 -p -q user
+
+# suspend accounts and charge a $10.23 fee for customers over 60 days past due
+20 4 * * * freeside-overdue -d 60 -s -l 10.23 user
+
+# cancel accounts over 90 days past due
+20 4 * * * freeside-overdue -d 90 -c user
+
+=head1 ORIGINAL AUTHORS
+
+Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ?
+
+Ivan seems to be turning it into the "do-everything" CLI.
+
+=head1 BUGS
+
+Hell now that this is the do-everything CLI it should have --longoptions
+
+=cut
+
+1;
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw( $log_file $sigterm $sigint $kids $max_kids );
+use subs qw( _die _logmsg );
+use Fcntl qw(:flock);
+use POSIX qw(setsid);
+use Date::Format;
+use IO::File;
+use FS::UID qw(adminsuidsetup forksuidsetup driver_name);
+use FS::Record qw(qsearchs);
+use FS::queue;
+
+# no autoloading just yet
+use FS::cust_main;
+use FS::svc_acct;
+use Net::SSH 0.05;
+use FS::part_export;
+
+my $pid_file = '/var/run/freeside-queued.pid';
+
+$max_kids = '10'; #guess it should be a config file...
+$kids = 0;
+
+my $user = shift or die &usage;
+
+&daemonize1;
+
+sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; }
+$SIG{CHLD} = \&REAPER;
+
+$sigterm = 0;
+$sigint = 0;
+$SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; };
+$SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
+
+$> = $FS::UID::freeside_uid unless $>;
+$< = $>;
+$ENV{HOME} = (getpwuid($>))[7]; #for ssh
+adminsuidsetup $user;
+
+$log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc;
+
+&daemonize2;
+
+$SIG{__DIE__} = \&_die;
+$SIG{__WARN__} = \&_logmsg;
+
+warn "freeside-queued starting\n";
+
+my $warnkids=0;
+while (1) {
+
+ #prevent runaway forking
+ if ( $kids >= $max_kids ) {
+ warn "WARNING: maximum $kids children reached\n" unless $warnkids++;
+ sleep 1; #waiting for signals is cheap
+ next;
+ }
+ $warnkids=0;
+
+ my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'.
+ ' WHERE queue_depend.jobnum = queue.jobnum ) ';
+
+ my $job = qsearchs(
+ 'queue',
+ { 'status' => 'new' },
+ '',
+ driver_name =~ /^mysql$/i
+ ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE"
+ : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1"
+ ) or do {
+ sleep 5; #connecting to db is expensive
+ next;
+ };
+
+ my %hash = $job->hash;
+ $hash{'status'} = 'locked';
+ my $ljob = new FS::queue ( \%hash );
+ my $error = $ljob->replace($job);
+ die $error if $error;
+
+ my @args = $ljob->args;
+
+ defined( my $pid = fork ) or do {
+ warn "WARNING: can't fork: $!\n";
+ my %hash = $job->hash;
+ $hash{'status'} = 'failed';
+ $hash{'statustext'} = "[freeside-queued] can't fork: $!";
+ my $ljob = new FS::queue ( \%hash );
+ my $error = $ljob->replace($job);
+ die $error if $error;
+ next; #don't increment the kid counter
+ };
+
+ if ( $pid ) {
+ $kids++;
+ } else { #kid time
+
+ #get new db handle
+ $FS::UID::dbh->{InactiveDestroy} = 1;
+
+ forksuidsetup($user);
+
+ #auto-use export classes...
+ if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) {
+ my $class = $1;
+ eval "use $class;";
+ if ( $@ ) {
+ warn "job use $class failed";
+ my %hash = $ljob->hash;
+ $hash{'status'} = 'failed';
+ $hash{'statustext'} = $@;
+ my $fjob = new FS::queue( \%hash );
+ my $error = $fjob->replace($ljob);
+ die $error if $error;
+ exit; #end-of-kid
+ };
+ }
+
+ my $eval = "&". $ljob->job. '(@args);';
+ warn "running $eval";
+ eval $eval; #throw away return value? suppose so
+ if ( $@ ) {
+ warn "job $eval failed";
+ my %hash = $ljob->hash;
+ $hash{'status'} = 'failed';
+ $hash{'statustext'} = $@;
+ my $fjob = new FS::queue( \%hash );
+ my $error = $fjob->replace($ljob);
+ die $error if $error;
+ } else {
+ $ljob->delete;
+ }
+
+ exit;
+ #end-of-kid
+ }
+
+} continue {
+ if ( $sigterm ) {
+ warn "received TERM signal; exiting\n";
+ exit;
+ }
+ if ( $sigint ) {
+ warn "received INT signal; exiting\n";
+ exit;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-queued user\n";
+}
+
+sub _die {
+ my $msg = shift;
+ unlink $pid_file if -e $pid_file;
+ _logmsg($msg);
+}
+
+sub _logmsg {
+ chomp( my $msg = shift );
+ my $log = new IO::File ">>$log_file";
+ flock($log, LOCK_EX);
+ seek($log, 0, 2);
+ print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
+ flock($log, LOCK_UN);
+ close $log;
+}
+
+sub daemonize1 {
+
+ chdir "/" or die "Can't chdir to /: $!";
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ defined(my $pid = fork) or die "Can't fork: $!";
+ if ( $pid ) {
+ print "freeside-queued started with pid $pid\n"; #logging to $log_file\n";
+ exit unless $pid_file;
+ my $pidfh = new IO::File ">$pid_file" or exit;
+ print $pidfh "$pid\n";
+ exit;
+ }
+ #open STDOUT, '>/dev/null'
+ # or die "Can't write to /dev/null: $!";
+ #setsid or die "Can't start a new session: $!";
+ #open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
+
+}
+
+sub daemonize2 {
+ open STDOUT, '>/dev/null'
+ or die "Can't write to /dev/null: $!";
+ setsid or die "Can't start a new session: $!";
+ open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
+}
+
+=head1 NAME
+
+freeside-queued - Job queue daemon
+
+=head1 SYNOPSIS
+
+ freeside-queued user
+
+=head1 DESCRIPTION
+
+Job queue daemon. Should be running at all times.
+
+user: from the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use Date::Parse;
+use Time::Local;
+use Getopt::Std;
+use Text::Template;
+use Net::SMTP;
+use Mail::Header;
+use Mail::Internet;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $report_lines $report_template @buf $header);
+getopts("vpmet:"); #switches
+
+#we're at now now (and later).
+my($_date)= $^T;
+
+# Get the current month
+my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($_date) )[0,1,2,3,4,5];
+$mon++;
+$year += 1900;
+
+# Login to the database
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# Get the needed configuration files
+my $conf = new FS::Conf;
+my $lpr = $conf->config('lpr');
+my $email = $conf->config('email');
+my $smtpmachine = $conf->config('smtpmachine');
+my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') :
+ 'postmaster';
+my @report_template = $conf->config('report_template')
+ or die "cannot load config file report_template";
+$report_lines = 0;
+ foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/
+ /report_lines\((\d+)\)/;
+ $report_lines += $1;
+}
+die "no report_lines() functions in template?" unless $report_lines;
+$report_template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @report_template ],
+) or die "can't create new Text::Template object: $Text::Template::ERROR";
+
+
+my(@customers)=qsearch('cust_main',{});
+if (scalar(@customers) == 0)
+{
+ exit 1;
+}
+
+# Open print and email pipes
+# $lpr and opt_p for printing
+# $email and opt_m for email
+
+if ($lpr && $opt_p)
+{
+ open(LPR, "|$lpr");
+}
+
+if ($email && $opt_m)
+{
+ $ENV{MAILADDRESS} = $mail_sender;
+ $header = new Mail::Header ( [
+ "From: Account Processor",
+ "To: $email",
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Subject: Receivables",
+ ] );
+}
+
+my $total = 0;
+
+
+# Now I can start looping
+foreach my $customer (@customers)
+{
+ my $custnum = $customer->getfield('custnum');
+ my $first = $customer->getfield('first');
+ my $last = $customer->getfield('last');
+ my $company = $customer->getfield('company');
+ my $daytime = $customer->getfield('daytime');
+ my $balance = $customer->balance;
+
+
+ if ($balance != 0) {
+ $total += $balance;
+ push @buf, sprintf(qq{%8d %-32.32s %12s %9.2f},
+ $custnum,
+ $first . " " . $last . " " . $company,
+ $daytime,
+ $balance);
+
+ }
+
+}
+
+push @buf, ('', sprintf(qq{%61s}, "========="), sprintf(qq{%61.2f}, $total));
+
+sub FS::receivables_report::_template::report_lines {
+ my $lines = shift;
+ map {
+ scalar(@buf) ? shift @buf : '' ;
+ }
+ ( 1 .. $lines );
+}
+
+$FS::receivables_report::_template::title = " R E C E I V A B L E S ";
+$FS::receivables_report::_template::title = $opt_t if $opt_t;
+$FS::receivables_report::_template::page = 1;
+$FS::receivables_report::_template::date = $_date;
+$FS::receivables_report::_template::date = $_date;
+$FS::receivables_report::_template::total_pages =
+ int( scalar(@buf) / $report_lines);
+$FS::receivables_report::_template::total_pages++ if scalar(@buf) % $report_lines;
+
+my @report;
+while (@buf) {
+ push @report, split("\n",
+ $report_template->fill_in( PACKAGE => 'FS::receivables_report::_template' )
+ );
+ $FS::receivables_report::_template::page++;
+}
+
+if ($opt_v) {
+ print map "$_\n", @report;
+}
+if($lpr && $opt_p)
+{
+ print LPR map "$_\n", @report;
+ print LPR "\f" if $opt_e;
+ close LPR || die "Could not close printer: $lpr\n";
+}
+if($email && $opt_m)
+{
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ (@report) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => "$smtpmachine" )
+ or die "can't send report to $email via $smtpmachine: $!";
+}
+
+
+# subroutines
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/ ]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-receivables-report [-v] [-p] [-e] user\n";
+}
+
+=head1 NAME
+
+freeside-receivables-report - Prints or emails outstanding receivables.
+
+=head1 SYNOPSIS
+
+ freeside-receivables-report [-v] [-p] [-m] [-e] [-t "title"] user
+
+=head1 DESCRIPTION
+
+Prints or emails outstanding receivables
+
+B<-v>: Verbose - Prints records to STDOUT.
+
+B<-p>: Print to printer lpr as found in the conf directory.
+
+B<-m>: Mail output to user found in the Conf email file.
+
+B<-e>: Print a final form feed to the printer.
+
+B<-t>: supply a title for the top of each page.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-receivables-report,v 1.5 2002-03-07 19:50:24 jeff Exp $
+
+=head1 BUGS
+
+Yes..... Use at your own risk. No guarantees or warrantees of any
+kind apply to this program. Parts of this program are hacked from
+other GNU licensed software created mainly by Ivan Kohler.
+
+This is released under the GNU Public License. See www.gnu.org
+for more information regarding this license.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 AUTHOR
+
+Jeff Finucane <jeff@cmh.net>
+
+based on print-batch by Joel Griffiths <griff@aver-computer.com>
+
+=cut
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+use FS::svc_acct;
+
+&untaint_argv; #what it sounds like (eww)
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+foreach my $cust_main (
+ grep { ! scalar($_->invoicing_list) }
+ qsearch( 'cust_main', {} )
+) {
+ my @dest;
+ my @cust_pkg = $cust_main->ncancelled_pkgs;
+ foreach my $cust_pkg ( @cust_pkg ) {
+ foreach my $cust_svc ( $cust_pkg->cust_svc ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $cust_svc->svcnum } );
+ push @dest, $svc_acct->svcnum if $svc_acct;
+ }
+ }
+ push @dest, 'POST' unless @dest;
+ $cust_main->invoicing_list(\@dest);
+}
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-setinvoice user\n";
+}
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::svc_acct;
+use FS::cust_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#my $machine = shift or die &usage;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'sqlradius' } );
+
+foreach my $export ( @exports ) {
+ my $icradius_dbh = DBI->connect(
+ map { $export->option($_) } qw( datasrc username password )
+ ) or die $DBI::errstr;
+ for my $table (qw( radcheck radreply usergroup )) {
+ my $sth = $icradius_dbh->prepare("DELETE FROM $table");
+ $sth->execute or die "Can't reset $table table: ". $sth->errstr;
+ }
+}
+
+foreach my $export ( @exports ) {
+
+ #my @svcparts = map { $_->svcpart } $export->export_svc;
+
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
+
+ foreach my $svc_acct ( @svc_acct ) {
+
+ #false laziness with FS::svc_acct::insert (like it matters)
+ my $error = $export->export_insert($svc_acct);
+ die $error if $error;
+
+ }
+}
+
+sub usage {
+ #die "Usage:\n\n sqlradius_reset user machine\n";
+ die "Usage:\n\n sqlradius_reset user\n";
+}
+
+=head1 NAME
+
+freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS SQL tables
+
+=head1 SYNOPSIS
+
+ freeside-sqlradius-reset username
+
+=head1 DESCRIPTION
+
+Deletes the radcheck, radreply and usergroup tables and repopulates them from
+the Freeside database, for all sqlradius exports.
+
+B<username> is a username added by freeside-adduser.
+
+=head1 SEE ALSO
+
+<FS::part_export>, L<FS::part_export::sqlradius>
+
+=cut
+
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+
+use strict;
+use Date::Parse;
+use Time::Local;
+use Getopt::Std;
+use Text::Template;
+use Net::SMTP;
+use Mail::Header;
+use Mail::Internet;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_bill;
+use FS::cust_bill_pay;
+use FS::cust_pay;
+
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header);
+getopts("vpmef:s:"); #switches
+
+#we're at now now (and later).
+my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T;
+my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T;
+
+# Get the current month
+my ($ssec,$smin,$shour,$smday,$smon,$syear) =
+ (localtime($_startdate) )[0,1,2,3,4,5];
+$smon++;
+$syear += 1900;
+
+# Get the current month
+my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) =
+ (localtime($_finishdate) )[0,1,2,3,4,5];
+$fmon++;
+$fyear += 1900;
+
+# Login to the database
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# Get the needed configuration files
+my $conf = new FS::Conf;
+my $lpr = $conf->config('lpr');
+my $email = $conf->config('email');
+my $smtpmachine = $conf->config('smtpmachine');
+my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') :
+ 'postmaster';
+my @report_template = $conf->config('report_template')
+ or die "cannot load config file report_template";
+$report_lines = 0;
+foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/
+ /report_lines\((\d+)\)/;
+ $report_lines += $1;
+}
+die "no report_lines() functions in template?" unless $report_lines;
+$report_template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", @report_template ],
+) or die "can't create new Text::Template object: $Text::Template::ERROR";
+
+
+my(@cust_bills)=qsearch('cust_bill',{});
+if (scalar(@cust_bills) == 0)
+{
+ exit 1;
+}
+
+# Open print and email pipes
+# $lpr and opt_p for printing
+# $email and opt_m for email
+
+if ($lpr && $main::opt_p)
+{
+ open(LPR, "|$lpr");
+}
+
+if ($email && $main::opt_m)
+{
+ $ENV{MAILADDRESS} = $mail_sender;
+ $header = new Mail::Header ( [
+ "From: Account Processor",
+ "To: $email",
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Subject: Sales Taxes Invoiced",
+ ] );
+}
+
+my $comped = 0;
+my $comped_tax = 0;
+my $other = 0;
+my $other_tax = 0;
+my $total = 0;
+my $taxed = 0;
+my $untaxed = 0;
+my $total_tax = 0;
+
+# Now I can start looping
+foreach my $cust_bill (@cust_bills)
+{
+ my $_date = $cust_bill->getfield('_date');
+ my $invnum = $cust_bill->getfield('invnum');
+ my $charged = $cust_bill->getfield('charged');
+
+ if ($_date >= $_startdate && $_date <= $_finishdate) {
+ $total += $charged;
+
+ # The following lines were used to produce rather verbose reports
+ #my ($sec,$min,$hour,$mday,$mon,$year) =
+ # (localtime($_date) )[0,1,2,3,4,5];
+ #$mon++;
+ #$year -= 100 if $year >= 100;
+ #$year = "0" . $year if $year < 10;
+
+ my $invoice_amt =0;
+ my $invoice_tax =0;
+ my $invoice_comped =0;
+ my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg;
+ foreach my $cust_bill_pkg (@cust_bill_pkgs) {
+
+ my $recur = $cust_bill_pkg->getfield('recur');
+ my $setup = $cust_bill_pkg->getfield('setup');
+ my $pkgnum = $cust_bill_pkg->getfield('pkgnum');
+
+ if ($pkgnum == 0) {
+ # The following line was used to produce rather verbose reports
+ # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup));
+ $invoice_tax += $recur;
+ $invoice_tax += $setup;
+ } else {
+ # The following line was used to produce rather verbose reports
+ # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup));
+ $invoice_amt += $recur;
+ $invoice_amt += $setup;
+ }
+
+ }
+
+ my(@cust_bill_pays)= $cust_bill->cust_bill_pay;
+ foreach my $cust_bill_pay (@cust_bill_pays) {
+ my $payby = $cust_bill_pay->cust_pay->payby;
+ my $paid = $cust_bill_pay->getfield('amount');
+ if ($payby =~ 'COMP') {
+ $invoice_comped += $paid;
+ }
+ }
+
+ if (abs($invoice_comped - ($invoice_amt + $invoice_tax)) < 0.0001){
+ $comped += $invoice_amt;
+ $comped_tax += $invoice_tax;
+ } elsif ($invoice_comped > 0) {
+ push @buf, sprintf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_comped);
+ $other += $invoice_amt;
+ $other_tax += $invoice_tax;
+ } elsif ($invoice_tax > 0) {
+ $total_tax += $invoice_tax;
+ $taxed += $invoice_amt;
+ } else {
+ $untaxed += $invoice_amt;
+ }
+
+ }
+
+}
+
+push @buf, ('', sprintf(qq{%25s%14.2f}, "Complimentary", $comped));
+push @buf, sprintf(qq{%25s%14.2f}, "Complimentary Tax", $comped_tax);
+push @buf, sprintf(qq{%25s%14.2f}, "Other", $other);
+push @buf, sprintf(qq{%25s%14.2f}, "Other Tax", $other_tax);
+push @buf, sprintf(qq{%25s%14.2f}, "Untaxed", $untaxed);
+push @buf, sprintf(qq{%25s%14.2f}, "Taxed", $taxed);
+push @buf, sprintf(qq{%25s%14.2f}, "Tax", $total_tax);
+push @buf, ('', sprintf(qq{%39s}, "========="), sprintf(qq{%39.2f}, $total));
+
+sub FS::tax_report::_template::report_lines {
+ my $lines = shift;
+ map {
+ scalar(@buf) ? shift @buf : '' ;
+ }
+ ( 1 .. $lines );
+}
+
+$FS::tax_report::_template::title = qq~SALES TAXES INVOICED for $smon/$smday/$syear through $fmon/$fmday/$fyear~;
+$FS::tax_report::_template::title = $opt_t if $opt_t;
+$FS::tax_report::_template::page = 1;
+$FS::tax_report::_template::date = $^T;
+$FS::tax_report::_template::date = $^T;
+$FS::tax_report::_template::fdate = $_finishdate;
+$FS::tax_report::_template::fdate = $_finishdate;
+$FS::tax_report::_template::sdate = $_startdate;
+$FS::tax_report::_template::sdate = $_startdate;
+$FS::tax_report::_template::total_pages =
+ int( scalar(@buf) / $report_lines);
+$FS::tax_report::_template::total_pages++ if scalar(@buf) % $report_lines;
+
+my @report;
+while (@buf) {
+ push @report, split("\n",
+ $report_template->fill_in( PACKAGE => 'FS::tax_report::_template' )
+ );
+ $FS::tax_report::_template::page++;
+}
+
+if ($opt_v) {
+ print map "$_\n", @report;
+}
+if($lpr && $opt_p)
+{
+ print LPR map "$_\n", @report;
+ print LPR "\f" if $opt_e;
+ close LPR || die "Could not close printer: $lpr\n";
+}
+if($email && $opt_m)
+{
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ (@report) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => "$smtpmachine" )
+ or die "can't send report to $email via $smtpmachine: $!";
+}
+
+
+# subroutines
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/ :]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n";
+}
+
+=head1 NAME
+
+freeside-tax-report - Prints or emails sales taxes invoiced in a given period.
+
+=head1 SYNOPSIS
+
+ freeside-tax-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user
+
+=head1 DESCRIPTION
+
+Prints or emails sales taxes invoiced in a given period.
+
+-v: Verbose - Prints records to STDOUT.
+
+-p: Print to printer lpr as found in the conf directory.
+
+-m: Email output to user found in the Conf email file.
+
+-e: Print a final form feed to the printer.
+
+-t: supply a title for the top of each page.
+
+-s: starting date for inclusion
+
+-f: final date for inclusion
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-tax-report,v 1.4 2002-03-07 19:50:24 jeff Exp $
+
+=head1 BUGS
+
+Yes..... Use at your own risk. No guarantees or warrantees of any
+kind apply to this program. Parts of this program are hacked from
+other GNU licensed software created mainly by Ivan Kohler.
+
+This is released under the GNU Public License. See www.gnu.org
+for more information regarding this license.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 AUTHOR
+
+Jeff Finucane <jeff@cmh.net>
+
+based on print-batch by Joel Griffiths <griff@aver-computer.com>
+
+=cut
+
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::CGI;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::Conf;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::ConfItem;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::Msgcat;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::Record;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::SearchCache;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::UID;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::agent;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::agent_type;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_bill;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_bill_event;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_bill_pay;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_bill_pkg;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_credit;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_credit_bill;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_credit_refund;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_main;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_main_county;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_main_invoice;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_pay;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_pay_batch;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_pkg;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_refund;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_svc;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_tax_exempt;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_tax_exempt;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::domain_record;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::export_svc;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::msgcat;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::nas;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_bill_event;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::bsdshell;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::cp;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::cyrus;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::infostreet;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::shellcommands;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::sqlradius;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::textradius;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::vpopmail;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export_option;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_pkg;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_pop_local;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_referral;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_svc;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_svc_column;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::pkg_svc;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::port;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::prepay_credit;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::queue;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::queue_arg;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::queue_depend;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::raddb;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::radius_usergroup;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::session;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_Common;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_acct;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_acct_pop;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_acct_sm;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_domain;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_forward;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::svc_www;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::type_pkgs;
+$loaded=1;
+print "ok 1\n";
-See htdocs/docs/index.html
+See httemplate/docs/index.html
--- /dev/null
+#!/usr/bin/make
+
+DATASOURCE = DBI:Pg:host=localhost;dbname=freeside
+#DATASOURCE=DBI:mysql:freeside
+
+DB_USER = freeside
+DB_PASSWORD=
+
+#TEMPLATE = asp
+TEMPLATE = mason
+
+ASP_GLOBAL = /usr/local/etc/freeside/asp-global
+
+FREESIDE_DOCUMENT_ROOT = /var/www/freeside
+
+INIT_FILE = /etc/init.d/freeside
+
+HTTPD_RESTART = /etc/init.d/apache restart
+FREESIDE_RESTART = /etc/init.d/freeside restart
+
+INSTALLGROUP = root
+
+#---
+
+#not changable yet
+FREESIDE_CONF = /usr/local/etc/freeside
+
+VERSION=1.4.0pre13
+TAG=freeside_1_4_0_pre13
+#VERSION=1.4.0beta1
+#TAG=freeside_1_4_0_beta1
+
+help:
+ @echo "supported targets: aspdocs masondocs alldocs docs install-docs"
+ @echo " htmlman"
+ @echo " perl-modules install-perl-modules"
+ @echo " install deploy"
+ @echo " create-database"
+ @echo " clean"
+
+aspdocs: htmlman httemplate/* httemplate/*/* httemplate/*/*/* httemplate/*/*/*/* httemplate/*/*/*/*/*
+ rm -rf aspdocs
+ cp -pr httemplate aspdocs
+ touch aspdocs
+
+masondocs: htmlman httemplate/* httemplate/*/* httemplate/*/*/* httemplate/*/*/*/* httemplate/*/*/*/*/*
+ rm -rf masondocs
+ cp -pr httemplate masondocs
+ ( cd masondocs; \
+ ../bin/masonize; \
+ )
+ touch masondocs
+
+alldocs: aspdocs masondocs
+
+docs:
+ make ${TEMPLATE}docs
+
+htmlman:
+ [ -e ./httemplate/docs/man ] || mkdir httemplate/docs/man
+ [ -e ./httemplate/docs/man/bin ] || mkdir httemplate/docs/man/bin
+ [ -e ./httemplate/docs/man/FS ] || mkdir httemplate/docs/man/FS
+ [ -e ./httemplate/docs/man/FS/UI ] || mkdir httemplate/docs/man/FS/UI
+ [ -e DONT_REBUILD_DOCS ] || bin/pod2x
+
+
+install-docs: docs
+ [ -e ${FREESIDE_DOCUMENT_ROOT} ] && mv ${FREESIDE_DOCUMENT_ROOT} ${FREESIDE_DOCUMENT_ROOT}.`date +%Y%m%d%H%M%S` || true
+ cp -r ${TEMPLATE}docs ${FREESIDE_DOCUMENT_ROOT}
+ [ "${TEMPLATE}" = "asp" -a ! -e ${ASP_GLOBAL} ] && mkdir ${ASP_GLOBAL} || true
+ [ "${TEMPLATE}" = "asp" ] && chown -R freeside ${ASP_GLOBAL} || true
+ [ "${TEMPLATE}" = "asp" ] && cp htetc/global.asa ${ASP_GLOBAL} || true
+
+perl-modules:
+ cd FS; \
+ [ -e Makefile ] || perl Makefile.PL; \
+ make
+
+install-perl-modules: perl-modules
+ cd FS; \
+ make install UNINST=1
+
+install-init:
+ #[ -e ${INIT_FILE} ] || install -o root -g ${INSTALLGROUP} -m 711 init.d/freeside-init ${INIT_FILE}
+ install -o root -g ${INSTALLGROUP} -m 711 init.d/freeside-init ${INIT_FILE}
+
+install: install-perl-modules install-docs install-init
+
+deploy: install
+ ${HTTPD_RESTART}
+ ${FREESIDE_RESTART}
+
+create-database:
+ perl -e 'use DBIx::DataSource qw( create_database ); create_database( "${DATASOURCE}", "${DB_USER}", "${DB_PASSWORD}" ) or die $$DBIx::DataSource::errstr;'
+
+create-config: install-perl-modules
+ [ -e ${FREESIDE_CONF} ] && mv ${FREESIDE_CONF} ${FREESIDE_CONF}.`date +%Y%m%d%H%M%S` || true
+ mkdir ${FREESIDE_CONF}
+ chown freeside ${FREESIDE_CONF}
+
+ touch ${FREESIDE_CONF}/secrets
+ chown freeside ${FREESIDE_CONF}/secrets
+ chmod 600 ${FREESIDE_CONF}/secrets
+
+ echo -e "${DATASOURCE}\n${DB_USER}\n${DB_PASSWORD}" >${FREESIDE_CONF}/secrets
+ chmod 600 ${FREESIDE_CONF}/secrets
+ chown freeside ${FREESIDE_CONF}/secrets
+
+ mkdir "${FREESIDE_CONF}/conf.${DATASOURCE}"
+ cp conf/[a-z]* "${FREESIDE_CONF}/conf.${DATASOURCE}"
+ chown -R freeside "${FREESIDE_CONF}/conf.${DATASOURCE}"
+
+ mkdir "${FREESIDE_CONF}/counters.${DATASOURCE}"
+ chown freeside "${FREESIDE_CONF}/counters.${DATASOURCE}"
+
+ mkdir "${FREESIDE_CONF}/cache.${DATASOURCE}"
+ chown freeside "${FREESIDE_CONF}/cache.${DATASOURCE}"
+
+ mkdir "${FREESIDE_CONF}/export.${DATASOURCE}"
+ chown freeside "${FREESIDE_CONF}/export.${DATASOURCE}"
+
+clean:
+ rm -rf aspdocs masondocs
+ cd FS; \
+ make clean
+
+#these are probably only useful if you're me...
+
+upload-docs:
+ ssh cleanwhisker.420.am rm -rf /var/www/www.sisd.com/freeside/devdocs
+ scp -pr httemplate/docs cleanwhisker.420.am:/var/www/www.sisd.com/freeside/devdocs
+
+release: upload-docs
+ cd /home/ivan/freeside_current
+ #cvs tag ${TAG}
+ cvs tag -F ${TAG}
+
+ #cd /home/ivan
+ cvs export -r ${TAG} -d freeside-${VERSION} freeside
+ tar czvf freeside-${VERSION}.tar.gz freeside-${VERSION}
+
+ scp freeside-${VERSION}.tar.gz ivan@cleanwhisker.420.am:/var/www/sisd.420.am/freeside/
+ mv freeside-${VERSION} freeside-${VERSION}.tar.gz ..
+
+update-webdemo:
+ ssh ivan@pouncequick.420.am '( cd freeside; cvs update -d -P )'
+ #ssh root@pouncequick.420.am '( cd /home/ivan/freeside; make clean; make deploy )'
+ ssh root@pouncequick.420.am '( cd /home/ivan/freeside; make deploy )'
+
-Freeside, (pre) 1.1.4
+Freeside 1.4.0
-Copyright (C) 1998 Silicon Interactive Software Design. All rights reserved.
+Copyright (C) 2000,2001 Ivan Kohler
+Copyright (C) 1999 Silicon Interactive Software Design
+All rights reserved
This program is free software; you can redistribute it and/or modify
it under the terms of either:
The Freeside home page is at `http://www.sisd.com/freeside'.
-The documentation is in `htdocs/docs'.
+The documentation is in `httemplate/docs'.
-A mailing list for users and developers is available. Send a blank message to
+A mailing list for users is available. Send a blank message to
<ivan-freeside-subscribe@sisd.com> to subscribe.
-Commercial support is available from Ivan Kohler <ivan@sisd.com>. Please
-subscribe to the the mailing list to request free support!
+A mailing list for developers is available. It is intended to be lower volume
+and higher SNR than the users list. Send a blank message to
+<ivan-freeside-devel-subscribe@sisd.com> to subscribe.
-Ivan Kohler
-ivan@sisd.com
+Commercial support is available from Ivan Kohler <ivan@sisd.com>. Requests for
+free support sent to me directly will be ignored. Please subscribe to the the
+user mailing list to request free support!
+
+Ivan Kohler <ivan-freeside_readme@420.am>
--- /dev/null
+the following is necessary to upgrade from 1.4.0pre ( 9 or 10 )
+to 1.4.0pre11
+
+if you're upgrading from before 1.4.0pre11 see README.1.4.0pre9 first!
+
+if you're upgrading from 1.3.1 follow the instructions in
+httemplate/docs/upgrade8.html instead
+
+----
+
+install rsync <http://rsync.samba.org/>
+
+install the FS perl modules and httemplate as per install.html or upgrade8.html
+
+ALTER TABLE queue ADD svcnum int NULL;
+ALTER TABLE queue ADD statustext text NULL;
+CREATE INDEX queue1 ON queue ( svcnum );
+CREATE INDEX queue2 ON queue ( status );
+
+DROP TABLE part_export_option;
+CREATE TABLE part_export_option (
+ optionnum int primary key,
+ exportnum int not null,
+ optionname varchar(80) not null,
+ optionvalue text NULL
+);
+CREATE INDEX part_export_option1 ON part_export_option ( exportnum );
+CREATE INDEX part_export_option2 ON part_export_option ( optionname );
+
+Run bin/dbdef-create
+
+Restart Apache and freeside-queued
+
--- /dev/null
+the following is necessary to upgrade from 1.4.0pre11 to 1.4.0pre12
+
+if you're upgrading from before 1.4.0pre12 see README.1.4.0pre11 first!
+
+if you're upgrading from 1.3.1 follow the instructions in
+httemplate/docs/upgrade8.html instead
+
+----
+
+install HTML-Widgets-SelectLayers from CPAN or http://www.420.am/selectlayers
+
+install the FS perl modules and httemplate as per install.html or upgrade8.html
+
+ALTER TABLE cust_bill_event ADD status varchar(80);
+ALTER TABLE cust_bill_event ADD statustext text NULL;
+UPDATE cust_bill_event SET status = 'done';
+DROP INDEX cust_bill_event1;
+
+CREATE TABLE radius_usergroup (
+ usergroupnum int primary key,
+ svcnum int not null,
+ groupname varchar(80) not null
+);
+CREATE INDEX radius_usergroup1 ON radius_usergroup ( svcnum );
+CREATE INDEX radius_usergroup2 ON radius_usergroup ( groupname );
+
+ALTER TABLE svc_acct ADD sec_phrase varchar(80) NULL;
+CREATE TABLE msgcat (
+ msgnum int primary key,
+ msgcode varchar(80) not null,
+ locale varchar(16) not null,
+ msg text not null
+);
+CREATE INDEX msgcat1 ON msgcat ( msgcode, locale );
+
+CREATE TABLE export_svc (
+ exportsvcnum int primary key,
+ exportnum int not null,
+ svcpart int not null
+);
+CREATE UNIQUE INDEX export_svc1 ON export_svc ( exportnum, svcpart );
+CREATE INDEX export_svc2 ON export_svc ( exportnum );
+CREATE INDEX export_svc3 ON export_svc ( svcpart );
+
+ALTER TABLE part_export RENAME svcpart TO deprecated;
+
+ALTER TABLE part_pkg ADD taxclass varchar(80) NULL;
+
+CREATE TABLE cust_tax_exempt (
+ exemptnum int primary key,
+ custnum int not null,
+ taxnum int not null,
+ year int not null,
+ month int not null,
+ amount decimal(10,2)
+);
+CREATE UNIQUE INDEX cust_tax_exempt1 ON cust_tax_exempt ( custnum, taxnum, year, month );
+
+ALTER TABLE cust_main_county ADD taxclass varchar(80) NULL;
+ALTER TABLE cust_main_county ADD exempt_amount decimal(10,2);
+
+Run bin/dbdef-create
+
+Run bin/create-history-tables
+
+Run bin/dbdef-create again
+
+Run bin/populate-msgcat
+
+Set the `locale' configuration option to `en_US'.
+
+the mxmachines, nsmachines, arecords and cnamerecords configuration values have been deprecated. Use the defaultrecords configuration value instead.
+
+New export code has landed! If you were using the icradiusmachines,
+icradius_mysqldest, icradius_mysqlsource, or icradius_secrets files, see
+the "sqlradius" export instead. Use MySQL replication
+<http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication>
+or point the "sqlradius" export directly at your external ICRADIUS or
+FreeRADIUS (or through an SSL-encrypting proxy...)
+
+Arrange for freeside-expiration-alerter to be run daily, if desired.
+
+Restart Apache and freeside-queued
+
--- /dev/null
+the following is necessary to upgrade from 1.4.0pre12 to 1.4.0pre13
+
+if you're upgrading from before 1.4.0pre13 see README.1.4.0pre12 first!
+
+if you're upgrading from 1.3.1 follow the instructions in
+httemplate/docs/upgrade8.html instead
+
+----
+
+install the FS perl modules and httemplate as per install.html or upgrade8.html
+
+CREATE TABLE queue_depend (
+ dependnum int primary key,
+ jobnum int not null,
+ depend_jobnum int not null
+);
+CREATE INDEX queue_depend1 ON queue_depend ( jobnum );
+CREATE INDEX queue_depend2 ON queue_depend ( depend_jobnum );
+
+Run bin/dbdef-create
+
+Run bin/create-history-tables [username] queue_depend
+
+Run bin/dbdef-create again
+
+Restart Apache and freeside-queued
+
--- /dev/null
+the following is necessary to upgrade from 1.4.0pre (4 thru 7) to 1.4.0pre8
+
+if you're upgrading from 1.3.1 follow the instructions in
+httemplate/docs/upgrade8.html instead
+
+if you're upgradeing from before 1.4.0pre4, see
+http://cleanwhisker.420.am/cgi-bin/cvsweb/freeside/Attic/
+
+-----
+
+install Time::Duration and Tie::IxHash
+
+install the FS perl modules and httemplate as per install.html or upgrade8.html
+
+ALTER TABLE part_pkg ADD disabled char(1) NULL;
+ALTER TABLE part_svc ADD disabled char(1) NULL;
+
+CREATE TABLE cust_bill_event (
+ eventnum int primary key,
+ invnum int not null,
+ eventpart int not null,
+ _date int not null
+);
+CREATE UNIQUE INDEX cust_bill_event1 ON cust_bill_event ( eventpart, invnum );
+CREATE INDEX cust_bill_event2 ON cust_bill_event ( invnum );
+
+CREATE TABLE part_bill_event (
+ eventpart int primary key,
+ payby char(4) not null,
+ event varchar(80) not null,
+ eventcode text null,
+ seconds int null,
+ weight int not null,
+ plan varchar(80) null,
+ plandata text null,
+ disabled char(1) null
+);
+CREATE INDEX part_bill_event1 ON part_bill_event ( payby );
+
+CREATE TABLE part_export (
+ exportnum int primary key,
+ svcpart int not null,
+ machine varchar(80) not null,
+ exporttype varchar(80) not null,
+ nodomain char(1) NULL
+);
+CREATE INDEX part_export1 ON part_export ( machine );
+CREATE INDEX part_export2 ON part_export ( exporttype );
+
+CREATE TABLE part_export_option (
+ optionnum int primary key,
+ exportnum int not null,
+ optionname varchar(80) not null,
+ optionvalue text NULL
+);
+CREATE INDEX part_export_option1 ON part_export_option ( exportnum );
+CREATE INDEX part_export_option2 ON part_export_option ( optionname );
+
+ALTER TABLE cust_bill ADD closed char(1) NULL;
+ALTER TABLE cust_pay ADD closed char(1) NULL;
+ALTER TABLE cust_credit ADD closed char(1) NULL;
+ALTER TABLE cust_refund ADD closed char(1) NULL;
+
+Run bin/dbdef-create
+
+Restart Apache and freeside-queued
+
+Go to the new "View/Edit Invoice events" in the web interface and add the
+appropriate events. At the very least, you'll want to set some invoice events
+"After 0 days": a BILL invoice event to print invoices, a CARD invoice event to
+batch or run cards real-time, and a COMP invoice event to "pay" complimentary
+customers. If you were using the -i option to freeside-bill it should be
+removed.
+
--- /dev/null
+the following is necessary to upgrade from 1.4.0pre8 to 1.4.0pre9
+
+if you're upgrading from before 1.4.0pre8 see README.1.4.0pre8 first!
+
+if you're upgrading from 1.3.1 follow the instructions in
+httemplate/docs/upgrade8.html instead
+
+-----
+
+install the FS perl modules and httemplate as per install.html or upgrade8.html
+
+CREATE INDEX cust_pay2 ON cust_pay ( custnum );
+CREATE INDEX cust_pay3 ON cust_pay ( paybatch );
+
+Run bin/dbdef-create
+
+Restart Apache and freeside-queued
+
+Use freeside-daily instead of freeside-bill.
+
+Use invoice events instead of freeside-overdue.
+
-If you are interested in helping with any of these, please join the mailing
-list (send a blank message to ivan-freeside-subscribe@sisd.com) to avoid
-duplication of effort.
+$Id: TODO,v 1.68 2002-02-16 18:14:23 ivan Exp $
--- 1.1.x --
-
-postgres can't deal with NULL!
-
-svc_acct.import should recognize "UNIX" in the RADIUS password file as null.
-
-radius logfile parsing and perl expression check.
-
-mailing list archive, faq, cvs
-
-(test cust_main.pm with cybercash v2 and v3)
-
-Fix in cust_bill BUGS:
-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).
-
-FIX It doesn't properly inherit/override FS::Record yet, so no more replace vs
-rep silliness!
-
-fields should be a method against a FS::Record or derived object, as well as
-being something you can call as FS::Record::fields('tablename'). Might
-even be able to handle both in the same routine (that would be neato).
-Get rid of hfields and other assorted silliness.
-Clean up hfields/sfields/fields crap. yuck.
-
-$lpr in cust_main.pm (from Bill.pm) should become /var/spool/freeside/conf/lpr
-
-Override FS::Record new, add, rep and del (create, insert, replace and
-delete) in all derived classes.
-IE create, insert, delete and replace from derived classes should override new,
-add, del and rep (respectively) from FS::Record. Depriciate old names.
-
-Allow a cancelled/suspended/active status from packages to bubble up to
-the customer lists. Put active, then suspended, then cancelled accounts.
-Similar ordering on the package listing inside a single customer.
-
-Add the ability for services to filter information up to the package level
-for invoices and web screens, so you can select a particlar package based
-on username or domain name, etc.
-
-You can't delete the stuff under administration yet. Add this,
-_including_ making sure the thing you are deleting is not in use!
-
-Immediate removal of incorrectly entered check payments (can't take too
-long to do this, or accounting is fubared).
-
-Add code to move from one service to another (POP to SLIP/PPP, etc.).
-This _should_ be possible by working off the rules in part_svc rather than
-hardcoding anything in. The rules in part_svc may need some elaboration,
-perhaps.
-
-Use ut_ FS::Record methods in all derived classes (possibly some from dbdef?... eventually all from dbdef??? - but then `dbdef-create' would be impossible as there would be metadata we couldn't ask the backend for. hmm.)
-
-(bring back from fsold, ) Generalize config-sending stuff and make more configurable.
-Expand the HylaFAX interface (also possibly generalize for other fax
-softwar ie .comfaxe); allow things like arbitrary faxes of sales
-literature, specific troubleshooting documents and so on. Maybe even
-allow users to do this (though that might not belong in Freeside).
-misc/sendconfig.cgi
-misc/process/sendconfig.cgi
-Configure fax recipients via a separate box rather than using the finger
-name or first+last from cust_main.
-
-move all phone number logic out of Freeside - let HylaFAX or whatever
-handle it.
-
-soundex searches for customer name and company? where are free soundex tools? (standard Text::Soundex duh)
-
-should be able to link on (username, domain name, some field in email alias) instead of svcnum only. (username done, what else?)
-
-(done but clean up) change svc_domain.pm mail sending from a pipe to "/usr/lib/sendmail" to Mail::Mailer or Net::SMTP or something. also is the complete text of the registration agreement needed in there (it used to be)?
-
-generalize and make configurable new invoice printing scheme in FS::Bill::collect (past due)
-
-deleting an svc_domain should delete all associated svc_acct_sm records.
-same with a svc_acct.
-
-periodic password encrypter
-
-Automated, configurable notification, suspension and cancellation of
-defunct accounts.
-...
-expire cron job
-...
-Allow for a future setup date on accounts.
-
-one-time/per-customer/? changes in rates and descriptions ('remembered
-invoices'): implement by creating a new package on the fly... but it isn't
-associated with any agent types so it won't show up for other customers to buy.
-
-if CGI::Base will not have redirect fixed (cgifix.html), should migrate to
-CGI.pm insetead? It is >1 year newer.
-
-library repetitve stuff from Bill.pm Invoice.pm and friends (calculating
-previous balances etc etc)
-
-
-sub AUTOLOAD in FS::Record should warn? die? if used with a non-existant column
-name?
-
-edit (not just import, export and allow default/fixed) arbitrary radius stuff
-in svc_acct
-
-edit/svc_acct.cgi and edit/process/svc_acct.cgi should deal with arbitrary radius stuff
-
-radius import should take DEFAULT entry and put it in /var/spool/freeside/conf/radius-default ; svc_acct.export should use it (and doc)
-
-FS::Invoice and FS::Bill should merge with the classes they're derived from
-
-in UI, s/State/State\/Provence/go and s/County/County\/Locality/go
-
-.us domains and others!
-
-what else (besides l10n) for i18n?
-
-audit htdocs/* for things that should be libraried and things that should be
-new methods on the objects (need to do this before implementing a new UI)
-all the big things are done
-
-some places we die() where we should &FS::CGI::idiot (and perhaps vice-versa).
-Decide based on whether or not the "error" should show up in logs.
-
-all .cgi's should use standard header/footer and idiot() subroutines. maybe HTML:: perl modules
-for HTML creation. CGI.pm instead.
-
-library the conf reading stuff; bin/svc_acct.export version with missing-filename checking is good
-library conf stuff -> check all the conf stuff to make sure they close filehandles.
-
-When running bin/bill, Fix this (Annoying but harmless):
-Use of uninitialized value at /usr/local/lib/site_perl/FS/cust_pkg.pm line 99, <ADDRESS> chunk 4.
-Use of uninitialized value at /usr/local/lib/site_perl/FS/cust_pkg.pm line 102, <ADDRESS> chunk 4.
-Use of uninitialized value at /usr/local/lib/site_perl/FS/cust_pkg.pm line 105, <ADDRESS> chunk 4.
-
-all cgi (but internal to the isp) places where package names are listed should also have
-comment (like agent_type)
-
-clean up $recref and other silliness and use -> calls where possible, or
-one other alternative. clean up everything else.
-should FS::Record use Tie::Hash? That would be very clean, but where do we
-store the other information? Maybe you could ask any FS::Record object for a
-tied hash?
-
-change all htdocs/edit/process/* loops to look like: (library this sort of thing!!!!)
-
-my($new) = create FS::svc_acct_sm ( {
- map {
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
-} );
-
-to avoid form errors causing too much silliness
-
-add this code to all svc_*.pm (already in acct and acct_sm and domain): (library!)
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
-change all file access from regular open(FILE,) stuff to OO, because of
-problems scoping and passing filehandles like that.
-
-svc_domain.pm mail sending uses Date::Format which doesn't seem to pick up
-correct timezone.
-
-view/svc_domain.cgi needs to know the domain might be unaudited (cosmetic)
-
-Check everything into CVS.
-
---- 1.1.x or 1.2 or later
-
-the web interface should create a new object and use it instead of a blank
-form for new records. the create method of svc_ objects should set defaults
-(from part_svc).
-
-sub check in man FS::table_name should be rewriteen. Get rid of $recref
-stuff. Make sure all fields that refer to other database are checked.
-
-Integration with signup disks (are there any free ones? Netscape?).
-
-One-button cancel (+refund) for lusers who can't get online.
-
-Keep information on virtual web servers (hostname, IP, host machine,
-directory, etc.) and export this information for importation into the ISPs
-web farm.
-
-Remove requirement that the first mail alias be the catchall? Still make
-sure only one catchall per domain is defined in any case, of course.
-
-Ability to move cust_pkg records from one customer to another? (proably
-will need to cancel the old and create a new like when we move services
-between packages).
-
-Auto-increment expired cards one year, and try again?
-
-Lay out the forms a bit better.
-
-More non-US stuff - zip codes, country codes, foreign currencies, etc.
-
-cust_refund.{cgi.pm} need to do cards xaxtions. (now we only have cust_credit)
-
-Nicer set of integrated reporting possibilities, like weekly sales totals
-by customer, package, agent, referral, etc., aging reports sorted by lots
-of different things, and so on.
-
-Client/server setup for users to modify their own passwords, shells, etc,
-via passwd or secure web interface (prelminary passwd/chfn/chsh
-replacement done). Complicated by the fact that we don't want to allow
-incoming connections to the machine running Freeside, so we probably need
-to have a daemon on each external shell or web machine that is contacted
-by the Freeside machine. Be very very careful for both traditional
-security issues and DoS problems.
-
-An extension of the above to allow users to modify selected parts of their
-own information, order and cancel services. A web interface for new
-customers.
-
-Expand domain name stuff to house all domain information. Export
-named.boot/named.conf (primary and secondary) and named.{domain} files.
-Add more registries (not just InterNIC's com org net edu)
-
-Nice postscript paper invoices, rather than current ASCII invoices.
-
-
-think about race-condititions in FS::Record and derived ->check ->insert
-and so on, uid and username checks in svc_acct, etc.
-
-Move to rsync over ssh file exportation rather than scp.
-
-check 'n fix the proactive password checker. (cracklib?)
-
-refunds of "BILL" payments: generate pseudo-check.
-
-write batch senders and batch parsers for the different credit card processors
-people use/
-More CC processors/methods.
-
-In FS::Record, the counter dir should have .datasrc appended to it like the
-dbdef does, which should place all the (most of) the DB metadata in unique
-files and let me run concurrent .datasrc's. Maybe do something similar for
-user, password and datasrc itself? (or something to get the out of the source
-files) and then we're set. (secrets file also needs .datasrc appended, or maybe
-"/var/spool/freeside".datasrc
-
-you should be able to fiddle the setup date in cust_pkg. (at least initially)
-
-cych v3 and v2 support
-
-delete options in administration section
-
-write a generic batch senders and batch parsers.
-
-need a way to override svc_acct export on a per-machine basis; just use config files based on machine name i suppose; document that.
-
-you should be able to get column types as a method against an FS::Record object
-as well as dbdef->table($table)->column($column)->type
-
-move to perl module for fuzzy and soundex searching.
-
-make fs-setup option to add sample data so you can click on "New Customer" right away? so people understand what this stuff is?
-
-package view needs to list extraneous services; we need to prevent the
-creation of them so this never happens (and mark it as such in the source)
-(the creation problem should be fixed - though they will still happen if people
-fsck around in the data manually, so list them anyway)
-
-add attribute dictionary to fs-setup as a menu, plus analyze users file to
-decide automatically
-
-Check for and report on duplicate billing accounts (cust_main, though many
-will have a need for these so probably don't disable them outright.)
-
-create a ->warn as well as a ->check method for all FS::table classes?
-(see above)
-
-something to automate making a release and updating the web demo
-
-export a debian-style (also redhat and?) /etc/group file aswell!
-
-seems to be an off-by-one error in the ascii invoice formatting which is saying
-"1 of 2" pages when there is only one.
-
-get rid of agrep? needs the (non-free) glimpse distribution. agrep used to
-be free? what else can do fuzzy searching?
-
-site_perl/svc_domain.cgi (hmm... or maybe should have a button? or maybe svc_domain.pm should handle this) should set $whois_hack for non-internic domains, so you can add them...
-
-svc_acct_sm.import qmail import should pull in recipientmap people too.
-
-.pm's like svc_acct.pm which need to do time-consuming things like ssh remotely
-should fork and do them in a child.
-
-i18n/l10n: take ALL messages and catalog them in english.txt or in database or something, so we can eventually go int'l. int'l currency support would be a help aswell.
-
-get some of { city, county, state, zip } from the missing bits if
-possible (where can i get the data to do this? usps.gov?)
-
-additional interfaces (perltk? java?)
-
-Put the GPL notice in all files.
-
--- 1.2 or later --
-
-$cust_bill->owed database field to be eliminated, replaced by a method call
-that calculates on the fly. make sure to grep for ->(get|set)field('owed')
-same for cust_credit->credited
-
-Export quota information.
-
-move all configuration to a central place. maybe in blob's in the
-database. maybe even things like the code to execute when a username is
-changed can be in there, so less of the distributed scripts change between
-different sites.
-
-Implement setup and recurring fees as Safe perl expressions rather than
-numbers, to allow for variable-rate services. Backwards compatibility is
-obtained because { 43 } in perl is still 43. :) Define API to pass
-starting and ending dates and any other necessary data to expression
-(fees are currently evaluated as Safe expressions but more work needs to
-be done to define an opmask for various needs, write examples
-(usage-based billing, etc.) and so on).
-...
-Add the ability to modify the next billing date in cust_pkg, and take
-appropriate action. This will allow the implementation of pro-rate/1st of
-the month billing as well as the ability to manually fiddle with
-anniversary dates in cust_pkg, so you can sync a customer's anniversary
-date even if you're using anniversary billing (manually or automatically).
-(now with above, we need to have a way to automatically pro-rate /^(\d+)$/
-charges - anything more complicated should figure it out itself given
-starting and ending dates [document that!])
-...
-Daily Radius log parsing into database; other logfile formats?
-...
-Callbacks to enforce hourly limits on accounts (suspend until the end of
-the billing period?), for those who limit customers rather than tack on
-extra charges.
-
-Flag packages (part_pkg) as taxable or non/taxable as some ISPs (for
-example) need to charge tax on equipment but not service (separate flags
-for setup and recurring fee... or perhaps a setup_tax, setup_notax,
-recur_tax and recur_notax fees, and possibly something more flexible if
-there is need).
-
-Allow for a variable number of invoices for customers who need multiple
-copies.
-
-Add a mail alias service with table svc_acct (not domain mail aliasing
-which is domain with svc_acct_sm)
-
-(bring back from fsold) Change customer comment field from its current kludge to something more
-workable.
-
-Better work orders with more information. Should eventually open a ticket
-when we have such a thing.
-edit/svc_wo.cgi
-edit/process/svc_wo.cgi
-Call tracking and trouble tickets.
-
-use mod_perl and Apache::AuthDBI instead of mod_auth_mysql when we do local
-users
-More accoutability for complimentary accounts: approval, expiration, term
-(no more than x months in advance) and notification.
-Flag particular users (or all users, for that matter) as having their
-passwords hidden and/or locked from users of Freeside (maybe need Freeside
-security levels first?).
-...
-Better Freeside-level configurable access, for those ISP's who have
-employees they can't trust. Right now you're "stuck" with setting up
-.htaccess stuff yourself. This should really just be integrated.
-
-update site_perl/table_template* (pry out of date)
-
-/var/spool/freeside/conf (and whatever else /var/spool/freeside we can)
-in database (except secrets), then web interface,
-make /var/spool/freeside a configurable directory (probably as part of
-some automated installation process?)
-
-add a table with column of export services (passwd, shadow, master.passwd, .qmail file update, dns update, etc.) and rows machine groups and whether or not to export that (and any necessary parameters). wasn't matt (vunderkid, not matt@michweb) working on this? find him? each machine goes in a group of its own as well as a group based on function. add a table with only svcpart and machine group. now, when you import from each machine, it can get its own accounts with one svcpart and universal accounts with another svcpart. (though that does make the username duplicate checking more interesting)
-
-password and slipip stuff in svc_acct.pm store need to be split into two fields or something, so the silliness in svc_acct.pm and svc_acct.export with looking at the data to decide what to do with it can be fixed (1.2)
-
-This requires some serious magic in FS::Record:
-ok, if date_type in fs-setup is to be something besides int,
-now we need to create wrappers
-for them so they behave identically across RDBMS's, ie date pops out as as
-UNIX timestamp (or an object of some sort? maybe even a blessed $obj which
-is a string not a hashref for backwards compatibility?) and so on. (remember
-to treat '0' as Not a Date instead of 1/1/70.
-
-Add Freeside-level transactions for RDBMS's which don't support
-transcations? (Currently we assume a minimal RDBMS which has no rollback,
-transactions or atomic updates). Or just require a RDBMS that supports
-rollback and/or atomic updates and get rid of the work-arounds? The /rdb
-interface had this kludge on top of it but is a technical dead-end in most
-other ways, unless it can gain an SQL parser and DBD interface.
-
-Better automated comparison of our CC records with processors (CyberCash,
-at least, has not always had 100% accuracy, though recent versions are
-much better)
-
-Expect or other pty based login check, where we actually connect to a
-terminal server or shell machine and test logging in as the user (if we
-are keeping a cleartext password for that user) (This is something tech
-support often needs for new customers)
-
-Use cust_main table for pre-sales tracking as well?
-
-Automatic commision report and check generation via freq and prog (to
-become a Safe perl expression) fields in agent table, and possibly others.
-
-Database and add a mailed-out date and method for disk/CD mailing, so a
-customer can call and you can say, "sent on xx/xx/xx via {US Mail, Fedex,
-UPS, etc}"
-
-Inventory tracking for physical items such as routers (for sale or
-lease... probably doesn't make a difference in the ordering... but if you
-cancel a router lease the inventory should come back. hmm.)
-
--- Matt's wishlist ---
-
-From matt@michweb.net Fri Feb 20 16:39:53 1998
-Date: Thu, 19 Feb 1998 23:20:11 -0500
-From: Matt Simerson <matt@michweb.net>
-Reply-To: quadran-developer@netgoth.com
-To: quadran-developer@netgoth.com
-Subject: Re: Welcome to quadran-developer
-
->Whats it based on and what is it supposed to do? I'm interested, but
->unfortunatly, I don't have that much time to help on the project (I'm busily
->working on one of my own based around MySQL and Qt right now -- don't know
->if it will be GPL'ed or not yet -- we'll probably just use it in house since
->it is designed around our system)...
-
-That's what I set out to find, but didn't find anything on the web site.
-I'm looking for something that will do the following:
-
-Single point of entry for users on a secure system:
- Creates account on user (public) systems
- update /etc/passwd/master.passwd file
- update radius database (if necessary)
- Set up up disk quotas (although I hacked adduser to do this)
- Option for adding user to a mailing list(s)
- Export of new user info to customizable report (for automated entry
-into
- accounting software, etc...)
-
-Automated billing:
- Export credit card info for batch processing and have hooks built
- in for other forms of electronic processing.
- Batch-Payment (apply payments from formatted text file).
- Customizable reports for manual entry/importing into Accounting
-software
- Email or laser print invoices
- Sanity checks credit card numbers before processing (code available)
-
-Simple method for disabling an account.
- Arbitrary Expiration Dates (on a given day, in x days)
- Remove from radius.
- Changing password to '*'
- Virtual customers disabling dns, http server, log processing, etc..
-
-Billing for different account types:
- Dialup monthly flat rate. Prorates for partial months.
- Dialup monthly flat rate for x hours + hourly usage.
- Dialup email only
- Email only accounts
- Virtual Web accounts - w/multiple mailboxes
- Leased line accounts
- Disk space used over quota.
- Tech support minimum + hourly charges
- Other for misc stuff (modem, RAM, etc...)
-
-Per user definable RADIUS attributes (ties in with above)
- Fixed IP
- Simultaneous Use
- IP filters (for dialup email only)
-
-Keep logs of modem usage generated daily from radius accounting logs stored
-on multiple radius servers.
-
-Keep logs of disk usage generated from quota.
-
-Method of adding virtual domains to your system:
- Automatically grabs an IP address from a preassigned pool.
- Creates a domain.com database file from database fields
- Updates /etc/named.conf or /etc/named.boot and reloads named.
- Add's virtual.com to /etc/sendmail.cw or qmail control files.
- Edits your web servers httpd.conf file and restarts http server.
- An optional section for adding vif's can be added if the users OS
- supports adding them on the fly. Otherwise it's up to the end
- user. Make a hook that can run a custom script that the user
- tweaks for his system.
- Update or create the config file your web stats analyzer needs. I've
- done this for analog (free) and http-analyze. Probably
- should only officially support analog and let users hack
- it to their hearts desire.
-I've already written scripts that do most of the virtual web stuff on my
-system...in bash. Shouldn't be hard for a perlmeister to convert. In fact,
-as long as all the info was stored in the database (username, domain name,
-and ip pool) this could easily just be run as an external script that the
-user tweaks to match his system.
-
-We use a great accounting software (M.Y.O.B) that does all the AP, AR,
-Payroll, Tax stuff, and most everything else we could need. It's already
-set up for the type of checks we have, etc, etc... I just need something to
-do the billing part. I can import/export sales and payments directly once
-the billing part is done. You can't write accounting software as good as
-M.Y.O.B. for $120.
+The TODO list / bug-tracking is now kept in a database. See
+http://pouncequick.420.am/rt/
+If you are interested in helping with any of these, please join the
+*development* mailing list (send a blank message to
+ivan-freeside-devel-subscribe@sisd.com) to avoid duplication of effort.
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# bill: Bill customer(s)
-#
-# Usage: bill [ -c [ i ] ] [ -d 'date' ] [ -b ]
-#
-# Bills all customers.
-#
-# Adds record to /dbin/cust_bill and /dbin/cust_pay (if payment made -
-# CARD & COMP), prints invoice / charges card etc.
-#
-# -c: Turn on collecting (you probably want this).
-#
-# -i: real-time billing (as opposed to batch billing). only relevant
-# for credit cards.
-#
-# -d: Pretent it's 'date'. Date is in any format Date::Parse is happy with,
-# but be careful.
-#
-# ## n/a ## -b: send batch when done billing
-#
-# ivan@voicenet.com sep/oct 96
-#
-# separated billing and collections, cleaned up code.
-# ivan@voicenet.com 96-nov-11
-#
-# added -d option
-# ivan@voicenet.com 96-nov-13
-#
-# added -v option and started to implement it, added 'd:' to getopts call
-# (oops!)
-# ivan@voicenet.com 97-jan-2
-#
-# added more debug messages, moved some searches to fssearch.pl library (for
-# speed)
-# rewrote "all customer" finder to know about bill dates, for speed.
-# ivan@voicenet.com 97-jan-8
-#
-# thought about it a while, and removed passing of the -d option to collect...?
-# ivan@voicenet.com 97-jan-14
-#
-# make all -v stuff STDERR
-# ivan@voicenet.com 97-feb-4
-#
-# added pkgnum as argument to program from /db/part_pkg, with kludge for the
-# "/bin/echo XX" 's already there.
-# ivan@voicenet.com 97-feb-23
-#
-# - general cleanup
-# - customers who are suspended can still be billed for the setup fee
-# - cust_pkg record is re-read after the package setup fee program is run.
-# this way,
-# that program can modify the record (for example, to start accounts off
-# suspended)
-# (best to think four or five times before modifying anything else!)
-# ivan@voicenet.com 97-feb-26
-#
-# don't bill recurring fee if its not time! (was removed)
-# ivan@voicenet.com 97-mar-6
-#
-# added -b option, send batch when done billing.
-# ivan@voicenet.com 97-apr-4
-#
-#insecure dependency on line 179ish below needs to be fixed before bill is
-#used setuid
-# ivan@voicenet.com 97-jun-2
-#
-# removed running of setup program (depriciated)
-# ivan@voicenet.com 97-jul-21
-#
-# rewrote for new API, removed option to specify custnums (use FS::Bill
-# instead), removed -v option (?)
-# ivan@voicenet.com 97-jul-22 - 23 - 25 -28
-# (need to add back in email stuff, look in /home/ivan/old/dbin/collect)
-#
-# s/suidsetup/adminsuidsetup/, s/FS::Search/FS::Record/, added some batch
-# exporting stuff (which still needs to be generalized) and removed &idiot
-# ivan@sisd.com 98-may-27
-
-# setup
-
-use strict;
-use Fcntl qw(:flock);
-use Date::Parse;
-use Getopt::Std;
-use FS::UID qw(adminsuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::Bill;
-
-my($batchfile)="/var/spool/freeside/batch";
-my($batchlock)="/var/spool/freeside/batch.lock";
-
-adminsuidsetup;
-
-&untaint_argv; #what it sounds like (eww)
-use vars qw($opt_b $opt_c $opt_i $opt_d);
-getopts("bcid:"); #switches
-
-#we're at now now (and later).
-my($time)= $main::opt_d ? str2time($main::opt_d) : $^T;
-
-# find packages w/ bill < time && cancel != '', and create corresponding
-# customer objects
-
-my($cust_main,%saw);
-foreach $cust_main (
- map {
- if ( ( $_->getfield('bill') || 0 ) <= $time &&
- !$saw{ $_->getfield('custnum') }++ ) {
- qsearchs('cust_main',{'custnum'=> $_->getfield('custnum') } );
- } else {
- ();
- }
- } qsearch('cust_pkg',{'cancel'=>''})
-) {
-
- # and bill them
-
- print "Billing customer #" . $cust_main->getfield('custnum') . "\n";
-
- bless($cust_main,"FS::Bill");
-
- my($error);
-
- $error=$cust_main->bill('time'=>$time);
- warn "Error billing, customer #" . $cust_main->getfield('custnum') .
- ":" . $error if $error;
-
- if ($main::opt_c) {
- $error=$cust_main->collect('invoice_time'=>$time,
- 'batch_card' => $main::opt_i ? 'no' : 'yes',
- );
- warn "Error collecting customer #" . $cust_main->getfield('custnum') .
- ":" . $error if $error;
-
- #sleep 1;
-
- }
-
-}
-
-#if ($main::opt_b) {
-#
-# die "Batch still waiting for reply? ($batchlock exists)\n" if -e $batchlock;
-# open(BATCHLOCK,"+>>$batchlock") or die "Can't open $batchlock: $!";
-# select(BATCHLOCK); $|=1; select(STDOUT);
-# unless ( flock(BATCHLOCK,,LOCK_EX|LOCK_NB) ) {
-# seek(BATCHLOCK,0,0);
-# my($pid)=<BATCHLOCK>;
-# chop($pid);
-# die "Is a batch running? (pid $pid)\n";
-# }
-# seek(BATCHLOCK,0,0);
-# print BATCHLOCK $$,"\n";
-#
-# ( open(BATCH,">$batchfile")
-# and flock(BATCH,LOCK_EX|LOCK_NB)
-# ) or die "Can't open $batchfile: $!";
-#
-# my($cust_pay_batch);
-# foreach $cust_pay_batch (qsearch('cust_pay_batch',{})) {
-# print BATCH join(':',
-# $_->getfield('cardnum'),
-# $_->getfield('exp'),
-# $_->getfield('amount'),
-# $_->getfield('payname')
-# || $_->getfield('first'). ' '. $_->getfield('last'),
-# "Description",
-# $_->getfield('zip'),
-# ),"\n";
-# }
-#
-# flock(BATCH,LOCK_UN);
-# close BATCH;
-#
-# flock(BATCHLOCK,LOCK_UN);
-# close BATCHLOCK;
-#}
-
-# subroutines
-
-sub untaint_argv {
- foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
- $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
- $ARGV[$_]=$1;
- }
-}
-
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use DBI;
+use DBIx::DBSchema 0.20;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(dbdef);
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $schema = dbdef();
+
+#false laziness w/fs-setup
+my @tables = scalar(@ARGV)
+ ? @ARGV
+ : grep { ! /^h_/ } $schema->tables;
+foreach my $table ( @tables ) {
+ warn "creating history table for $table\n";
+ my $tableobj = $schema->table($table)
+ or die "unknown table $table (did you run dbdef-create?)\n";
+ my $h_tableobj = DBIx::DBSchema::Table->new( {
+ name => "h_$table",
+ primary_key => 'historynum',
+ unique => DBIx::DBSchema::ColGroup::Unique->new( [] ),
+ 'index' => DBIx::DBSchema::ColGroup::Index->new( [
+ @{$tableobj->unique->lol_ref},
+ @{$tableobj->index->lol_ref}
+ ] ),
+ columns => [
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'historynum',
+ 'type' => 'serial',
+ 'null' => 'NOT NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_date',
+ 'type' => 'int',
+ 'null' => 'NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_user',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_action',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ map { $tableobj->column($_) } $tableobj->columns
+ ],
+ } );
+ foreach my $statement ( $h_tableobj->sql_create_table($dbh) ) {
+ $dbh->do( $statement )
+ or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement";
+ }
+
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n create-history-tables user [ table table ... ] \n";
+}
+
#!/usr/bin/perl -Tw
#
-# create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command
-# not in Pg) based on fs-setup
-#
-# ivan@sisd.com 98-jun-2
+# $Id: dbdef-create,v 1.5 2001-08-21 02:43:18 ivan Exp $
use strict;
use DBI;
-use FS::dbdef;
-use FS::UID qw(adminsuidsetup datasrc);
-
-#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
-
-my($dbh)=adminsuidsetup;
-
-my($tables_sth)=$dbh->prepare("SHOW TABLES");
-my($tables_rv)=$tables_sth->execute;
+use DBIx::DBSchema;
+use FS::UID qw(adminsuidsetup datasrc driver_name);
-my(@tables);
-foreach ( @{$tables_sth->fetchall_arrayref} ) {
- my($table)=${$_}[0];
- #print "TABLE\t$table\n";
+my $user = shift or die &usage;
- my($index_sth)=$dbh->prepare("SHOW INDEX FROM $table");
- my($primary_key)='';
- my(%index,%unique);
- for ( 1 .. $index_sth->execute ) {
- my($row)=$index_sth->fetchrow_hashref;
- if ( ${$row}{'Key_name'} eq "PRIMARY" ) {
- $primary_key=${$row}{'Column_name'};
- next;
- }
- if ( ${$row}{'Non_unique'} ) { #index
- push @{$index{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
- } else { #unique
- push @{$unique{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
- }
- }
+my($dbh)=adminsuidsetup $user;
- my(@index)=values %index;
- my(@unique)=values %unique;
- #print "\tPRIMARY KEY $primary_key\n";
- foreach (@index) {
- #print "\tINDEX\t", join(', ', @{$_}), "\n";
- }
- foreach (@unique) {
- #print "\tUNIQUE\t", join(', ', @{$_}), "\n";
- }
-
- my($columns_sth)=$dbh->prepare("SHOW COLUMNS FROM $table");
- my(@columns);
- for ( 1 .. $columns_sth->execute ) {
- my($row)=$columns_sth->fetchrow_hashref;
- #print "\t", ${$row}{'Field'}, "\n";
- ${$row}{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
- or die "Illegal type ${$row}{'Type'}\n";
- my($type,$length)=($1,$2);
- my($null)=${$row}{'Null'};
- $null =~ s/YES/NULL/;
- push @columns, new FS::dbdef_column (
- ${$row}{'Field'},
- $type,
- $null,
- $length,
- );
- }
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
- #print "\n";
- push @tables, new FS::dbdef_table (
- $table,
- $primary_key,
- new FS::dbdef_unique (\@unique),
- new FS::dbdef_index (\@index),
- @columns,
- );
+my $dbdef = new_native DBIx::DBSchema $dbh;
-}
-
-my($dbdef) = new FS::dbdef ( @tables );
+#print $dbdef->pretty_print;
#important
$dbdef->save($dbdef_file);
+sub usage {
+ die "Usage:\n dbdef-create user\n";
+}
--- /dev/null
+#! /bin/sh
+#
+# start the freeside job queue daemon
+
+#PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin
+DAEMON=/usr/local/bin/freeside-queued
+NAME=freeside-queued
+DESC="freeside job queue daemon"
+USER="ivan"
+
+test -f $DAEMON || exit 0
+
+set -e
+
+case "$1" in
+ start)
+ echo -n "Starting $DESC: "
+# start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid -b -m\
+# --exec $DAEMON
+ $DAEMON $USER &
+ echo "$NAME."
+ ;;
+ stop)
+ echo -n "Stopping $DESC: "
+ start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \
+ --exec $DAEMON
+ echo "$NAME."
+ rm /var/run/$NAME.pid
+ ;;
+ #reload)
+ #
+ # If the daemon can reload its config files on the fly
+ # for example by sending it SIGHUP, do it here.
+ #
+ # If the daemon responds to changes in its config file
+ # directly anyway, make this a do-nothing entry.
+ #
+ # echo "Reloading $DESC configuration files."
+ # start-stop-daemon --stop --signal 1 --quiet --pidfile \
+ # /var/run/$NAME.pid --exec $DAEMON
+ #;;
+ restart|force-reload)
+ #
+ # If the "reload" option is implemented, move the "force-reload"
+ # option to the "reload" entry above. If not, "force-reload" is
+ # just the same as "restart".
+ #
+ $0 stop
+ sleep 1
+ $0 start
+ ;;
+ *)
+ N=/etc/init.d/$NAME
+ # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2
+ echo "Usage: $N {start|stop|restart|force-reload}" >&2
+ exit 1
+ ;;
+esac
+
+exit 0
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($conf);
+use Fcntl qw(:flock);
+use FS::UID qw(adminsuidsetup datasrc dbh);
+use FS::Record qw(dbdef qsearch fields);
+use FS::session;
+use FS::svc_acct;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $sessionlock = "/usr/local/etc/freeside/session-kill.lock.". datasrc;
+
+open(LOCK,"+>>$sessionlock") or die "Can't open $sessionlock: $!";
+select(LOCK); $|=1; select(STDOUT);
+unless ( flock(LOCK,LOCK_EX|LOCK_NB) ) {
+ seek(LOCK,0,0);
+ my($pid)=<LOCK>;
+ chop($pid);
+ #no reason to start loct of blocking processes
+ die "Is another session kill process running under pid $pid?\n";
+}
+seek(LOCK,0,0);
+print LOCK $$,"\n";
+
+$FS::UID::AutoCommit = 0;
+
+my $now = time;
+
+#uhhhhh
+
+use DBIx::DBSchema;
+use DBIx::DBSchema::Table; #down this path lies madness
+use DBIx::DBSchema::Column;
+
+my $dbdef = dbdef or die;
+#warn $dbdef;
+#warn $dbdef->{'tables'};
+#warn keys %{$dbdef->{'tables'}};
+my $session_table = $dbdef->table('session') or die;
+my $svc_acct_table = $dbdef->table('svc_acct') or die;
+
+my $session_svc_acct = new DBIx::DBSchema::Table ( 'session,svc_acct', '', '', '',
+ map( DBIx::DBSchema::Column->new( "session.$_",
+ $session_table->column($_)->type,
+ $session_table->column($_)->null,
+ $session_table->column($_)->length,
+ ), $session_table->columns() ),
+ map( DBIx::DBSchema::Column->new( "svc_acct.$_",
+ $svc_acct_table->column($_)->type,
+ $svc_acct_table->column($_)->null,
+ $svc_acct_table->column($_)->length,
+ ), $svc_acct_table->columns ),
+# map("svc_acct.$_", $svc_acct_table->columns),
+);
+
+$dbdef->addtable($session_svc_acct); #madness, i tell you
+
+$FS::Record::DEBUG = 1;
+my @session = qsearch('session,svc_acct', {}, '', ' WHERE '. join(' AND ',
+ 'svc_acct.svcnum = session.svcnum',
+ '( session.logout IS NULL OR session.logout = 0 )',
+ "( $now - session.login ) >= svc_acct.seconds"
+). " FOR UPDATE" );
+
+my $dbh = dbh;
+
+foreach my $join ( @session ) {
+
+ my $session = new FS::session ( {
+ map { $_ => $join->{'Hash'}{"session.$_"} } fields('session')
+ } ); #see no evil
+
+ my $svc_acct = new FS::svc_acct ( {
+ map { $_ => $join->{'Hash'}{"svc_acct.$_"} } fields('svc_acct')
+ } );
+
+ #false laziness w/ fs_session_server
+ my $nsession = new FS::session ( { $session->hash } );
+ my $error = $nsession->replace($session);
+ if ( $error ) {
+ $dbh->rollback;
+ die $error;
+ }
+ my $time = $nsession->logout - $nsession->login;
+ my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ my $seconds = $new_svc_acct->seconds;
+ $seconds -= $time;
+ $seconds = 0 if $seconds < 0;
+ $new_svc_acct->seconds( $seconds );
+ $error = $new_svc_acct->replace( $svc_acct );
+ warn "can't debit time from ". $svc_acct->username. ": $error\n"; #don't want to rollback, though
+ #ssenizal eslaf
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n\n freeside-session-kill user\n";
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch fields);
+use FS::part_svc;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $oldAutoCommit = $FS::UID::AutoCommit;
+local $FS::UID::AutoCommit = 0;
+
+foreach my $part_svc ( qsearch('part_svc', {} ) ) {
+ foreach my $field (
+ grep { defined($part_svc->getfield($part_svc->svcdb.'__'.$_.'_flag') ) }
+ fields($part_svc->svcdb)
+ ) {
+ my $flag = $part_svc->getfield($part_svc->svcdb.'__'.$field.'_flag');
+ if ( uc($flag) =~ /^([DF])$/ ) {
+ my $part_svc_column = new FS::part_svc_column {
+ 'svcpart' => $part_svc->svcpart,
+ 'columnname' => $field,
+ 'columnflag' => $1,
+ 'columnvalue' => $part_svc->getfield($part_svc->svcdb.'__'.$field),
+ };
+ my $error = $part_svc_column->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+ }
+ }
+}
+
+$dbh->commit or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n fs-migrate-part_svc user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_pay;
+use FS::cust_refund;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+# apply payments to invoices
+
+foreach my $cust_pay ( qsearch('cust_pay', {} ) ) {
+ my $error = $cust_pay->upgrade_replace;
+ warn $error if $error;
+}
+
+# apply refunds to credits
+
+foreach my $cust_refund ( qsearch('cust_refund') ) {
+ my $error = $cust_refund->upgrade_replace;
+ warn $error if $error;
+}
+
+# ? apply credits to invoices
+
+sub usage {
+ die "Usage:\n fs-migrate-payref user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: fs-migrate-svc_acct_sm,v 1.3 2001-08-21 02:43:18 ivan Exp $
+#
+# jeff@cmh.net 01-Jul-20
+
+#to delay loading dbdef until we're ready
+#BEGIN { $FS::Record::setup_hack = 1; }
+
+use strict;
+use Term::Query qw(query);
+#use DBI;
+#use DBIx::DBSchema;
+#use DBIx::DBSchema::Table;
+#use DBIx::DBSchema::Column;
+#use DBIx::DBSchema::ColGroup::Unique;
+#use DBIx::DBSchema::ColGroup::Index;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_domain;
+use FS::svc_forward;
+use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error);
+
+die "Not running uid freeside!" unless checkeuid();
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+$conf = new FS::Conf;
+$old_default_domain = $conf->config('domain');
+
+#needs to match FS::Record
+#my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+###
+# This section would be the appropriate place to manipulate
+# the schema & tables.
+###
+
+## we need to add the domsvc to svc_acct
+## we must add a svc_forward record....
+## I am thinking that the fields svcnum (int), destsvc (int), and
+## dest (varchar (80)) are appropriate, with destsvc/dest an either/or
+## much in the spirit of cust_main_invoice
+
+###
+# massage the data
+###
+
+my($dbh)=adminsuidsetup $user;
+
+$|=1;
+
+$FS::svc_acct::nossh_hack = 1;
+$FS::svc_forward::nossh_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+%part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+%part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'});
+
+die "No services with svcdb svc_domain!\n" unless %part_domain_svc;
+die "No services with svcdb svc_acct!\n" unless %part_acct_svc;
+die "No services with svcdb svc_forward!\n" unless %part_forward_svc;
+
+my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
+if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
+ print <<EOF;
+
+Your database currently does not contain a svc_domain record for the
+domain $old_default_domain. Would you like me to add one for you?
+EOF
+
+ my($response)=scalar(<STDIN>);
+ chop $response;
+ if ($response =~ /^[yY]/) {
+ print "\n\n", &menu_domain_svc, "\n", <<END;
+I need to create new domain accounts. Which service shall I use for that?
+END
+ my($domain_svcpart)=&getdomainpart;
+
+ $svc_domain = new FS::svc_domain {
+ 'domain' => $old_default_domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'M',
+ };
+# $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error";
+ $error=$svc_domain->insert;
+ die "Error adding domain $old_default_domain: $error" if $error;
+ }else{
+ print <<EOF;
+
+ This program cannot function properly until a svc_domain record matching
+your conf_dir/domain file exists.
+EOF
+
+ exit 1;
+ }
+}
+
+print "\n\n", &menu_acct_svc, "\n", <<END;
+I may need to create some new pop accounts and set up forwarding to them
+for some users. Which service shall I use for that?
+END
+my($pop_svcpart)=&getacctpart;
+
+print "\n\n", &menu_forward_svc, "\n", <<END;
+I may need to create some new forwarding for some users. Which service
+shall I use for that?
+END
+my($forward_svcpart)=&getforwardpart;
+
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
+}
+sub menu_acct_svc {
+ ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
+}
+sub menu_forward_svc {
+ ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
+ $^W=1;
+ $return;
+}
+sub getacctpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
+ $^W=1;
+ $return;
+}
+sub getforwardpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
+ $^W=1;
+ $return;
+}
+
+
+#migrate data
+
+my(@svc_accts) = qsearch('svc_acct', {});
+foreach $svc_acct (@svc_accts) {
+ my(@svc_acct_sms) = qsearch('svc_acct_sm', {
+ domuid => $svc_acct->getfield('uid'),
+ }
+ );
+
+ # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
+ # What do we do from here?
+
+ # The intuitive:
+ # plop the svc_acct into the 'default domain'
+ # and then represent the svc_acct_sm's with svc_forwards
+ # they can be gussied up manually, later
+ #
+ # Perhaps better:
+ # when no svc_acct_sm exists, place svc_acct in 'default domain'
+ # when one svc_acct_sm exists, place svc_acct in corresponding
+ # domain & possibly create a svc_forward in 'default domain'
+ # when multiple svc_acct_sm's exists (in different domains) we'd
+ # better use the 'intuitive' approach.
+ #
+ # Specific way:
+ # as 'perhaps better,' but we may be able to guess which domain
+ # is correct by comparing the svcnum of domains to the username
+ # of the svc_acct
+ #
+
+ # The intuitive way:
+
+ my $def_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum'));
+ $error = $def_acct->replace($svc_acct);
+ die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error;
+
+ foreach $svc_acct_sm (@svc_acct_sms) {
+
+ my($domrec)=qsearchs('svc_domain', {
+ svcnum => $svc_acct_sm->getfield('domsvc'),
+ }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n";
+
+ if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
+
+ my($newdom) = new FS::svc_domain ( { $domrec->hash } );
+ $newdom->setfield('catchall', $svc_acct->svcnum);
+ $newdom->setfield('action', "M");
+ $error = $newdom->replace($domrec);
+ die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error;
+
+ } else {
+
+ my($newacct) = new FS::svc_acct {
+ 'svcpart' => $pop_svcpart,
+ 'username' => $svc_acct_sm->getfield('domuser'),
+ 'domsvc' => $svc_acct_sm->getfield('domsvc'),
+ 'dir' => '/dev/null',
+ };
+ $error = $newacct->insert;
+ die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
+
+ my($newforward) = new FS::svc_forward {
+ 'svcpart' => $forward_svcpart,
+ 'srcsvc' => $newacct->getfield('svcnum'),
+ 'dstsvc' => $def_acct->getfield('svcnum'),
+ };
+ $error = $newforward->insert;
+ die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
+ }
+
+ $error = $svc_acct_sm->delete;
+ die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
+
+ };
+
+};
+
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+print "svc_acct_sm records sucessfully migrated\n";
+
+sub usage {
+ die "Usage:\n fs-migrate-svc_acct_sm user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+# quick'n'dirty hack of fs-setup to add radius attributes
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup checkeuid getsecrets);
+use FS::raddb;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+my $dbh = adminsuidsetup $user;
+
+###
+
+print "\n\n", <<END, ":";
+Enter the additional RADIUS check attributes you need to track for
+each user, separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+
+ my $statement =
+ "ALTER TABLE svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL";
+ my $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ my $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+ $statement =
+ "ALTER TABLE h_svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL";
+ $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+$dbh->disconnect or die $dbh->errstr;
+
+print "\n\n", "Now you must run dbdef-create.\n\n";
+
+sub usage {
+ die "Usage:\n fs-radius-add-check user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+# quick'n'dirty hack of fs-setup to add radius attributes
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup checkeuid getsecrets);
+use FS::raddb;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+my $dbh = adminsuidsetup $user;
+
+###
+
+print "\n\n", <<END, ":";
+Enter the additional RADIUS reply attributes you need to track for
+each user, separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+
+ my $statement =
+ "ALTER TABLE svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL";
+ my $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ my $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+ $statement =
+ "ALTER TABLE h_svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL";
+ $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+$dbh->disconnect or die $dbh->errstr;
+
+print "\n\n", "Now you must run dbdef-create.\n\n";
+
+sub usage {
+ die "Usage:\n fs-radius-add-reply user\n";
+}
+
+
#!/usr/bin/perl -Tw
#
-# create database and necessary tables, etc. DBI version.
-#
-# ivan@sisd.com 97-nov-8,9
-#
-# agent_type and type_pkgs added.
-# (index need to be declared, & primary keys shoudln't have mysql syntax)
-# ivan@sisd.com 97-nov-13
-#
-# pulled modified version back out of register.cgi ivan@sisd.com 98-feb-21
-#
-# removed extraneous sample data ivan@sisd.com 98-mar-23
-#
-# gained the big hash from dbdef.pm, dbdef.pm usage rewrite ivan@sisd.com
-# 98-apr-19 - 98-may-11 plus
-#
-# finished up ivan@sisd.com 98-jun-1
-#
-# part_svc fields are all forced NULL, not the opposite
-# hmm: also are forced varchar($char_d) as fixed '0' for things like
-# uid is Not Good. will this break anything else?
-# ivan@sisd.com 98-jun-29
-#
-# ss is 11 chars ivan@sisd.com 98-jul-20
-#
-# setup of arbitrary radius fields ivan@sisd.com 98-aug-9
-#
-# ouch, removed index on company name that wasn't supposed to be there
-# ivan@sisd.com 98-sep-4
-#
-# fix radius attributes ivan@sisd.com 98-sep-27
+# $Id: fs-setup,v 1.91 2002-05-15 13:24:24 ivan Exp $
#to delay loading dbdef until we're ready
BEGIN { $FS::Record::setup_hack = 1; }
use strict;
use DBI;
-use FS::dbdef;
-use FS::UID qw(adminsuidsetup datasrc);
+use DBIx::DBSchema 0.20;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
use FS::Record;
use FS::cust_main_county;
+use FS::raddb;
+use FS::part_bill_event;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
###
-print "\nEnter the maximum username length: ";
-my($username_len)=&getvalue;
+#print "\nEnter the maximum username length: ";
+#my($username_len)=&getvalue;
+my $username_len = 32; #usernamemax config file
+
+print "\n\n", <<END, ":";
+Freeside tracks the RADIUS User-Name, check attribute Password and
+reply attribute Framed-IP-Address for each user. You can specify additional
+check and reply attributes (or you can add them later with the
+fs-radius-add-check and fs-radius-add-reply programs).
+
+First enter any additional RADIUS check attributes you need to track for each
+user, separated by whitespace.
+END
+my @check_attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+print "\n\n", <<END, ":";
+Now enter any additional reply attributes you need to track for each user,
+separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
print "\n\n", <<END, ":";
-Freeside tracks the RADIUS attributes User-Name, Password and Framed-IP-Address
-for each user. Enter any additional RADIUS attributes you need to track for
-each user, separated by whitespace.
+Do you wish to enable the tracking of a second, separate shipping/service
+address?
END
-my @attributes = map { s/\-/_/g; $_; } split(" ",&getvalue);
+my $ship = &_yesno;
sub getvalue {
my($x)=scalar(<STDIN>);
$x;
}
+sub _yesno {
+ print " [y/N]:";
+ my $x = scalar(<STDIN>);
+ $x =~ /^y/i;
+}
+
###
my($char_d) = 80; #default maxlength for text fields
#my(@date_type) = ( 'timestamp', '', '' );
my(@date_type) = ( 'int', 'NULL', '' );
-my(@perl_type) = ( 'long varchar', 'NULL', '' );
-my(@money_type);
-if (datasrc =~ m/Pg/) { #Pg can't do decimal(10,2)
- @money_type = ( 'money', '', '' );
-} else {
- @money_type = ( 'decimal', '', '10,2' );
-}
+my(@perl_type) = ( 'text', 'NULL', '' );
+my @money_type = ( 'decimal', '', '10,2' );
###
# create a dbdef object from the old data structure
my(%tables)=&tables_hash_hack;
#turn it into objects
-my($dbdef) = new FS::dbdef ( map {
+my($dbdef) = new DBIx::DBSchema ( map {
my(@columns);
while (@{$tables{$_}{'columns'}}) {
my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4;
- push @columns, new FS::dbdef_column ( $name,$type,$null,$length );
+ push @columns, new DBIx::DBSchema::Column ( $name,$type,$null,$length );
}
- FS::dbdef_table->new(
+ DBIx::DBSchema::Table->new(
$_,
$tables{$_}{'primary_key'},
- #FS::dbdef_unique->new(@{$tables{$_}{'unique'}}),
- #FS::dbdef_index->new(@{$tables{$_}{'index'}}),
- FS::dbdef_unique->new($tables{$_}{'unique'}),
- FS::dbdef_index->new($tables{$_}{'index'}),
+ DBIx::DBSchema::ColGroup::Unique->new($tables{$_}{'unique'}),
+ DBIx::DBSchema::ColGroup::Index->new($tables{$_}{'index'}),
@columns,
);
} (keys %tables) );
+my $cust_main = $dbdef->table('cust_main');
+unless ($ship) { #remove ship_ from cust_main
+ $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns );
+} else { #add indices on ship_last and ship_company
+ push @{$cust_main->index->lol_ref}, ( ['ship_last'], ['ship_company'] )
+}
+
#add radius attributes to svc_acct
my($svc_acct)=$dbdef->table('svc_acct');
my($attribute);
foreach $attribute (@attributes) {
- $svc_acct->addcolumn ( new FS::dbdef_column (
+ $svc_acct->addcolumn ( new DBIx::DBSchema::Column (
'radius_'. $attribute,
'varchar',
'NULL',
));
}
-#make part_svc table (but now as object)
-
-my($part_svc)=$dbdef->table('part_svc');
-
-#because of svc_acct_pop
-#foreach (grep /^svc_/, $dbdef->tables) {
-#foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
-foreach (qw(svc_acct svc_acct_sm svc_domain)) {
- my($table)=$dbdef->table($_);
- my($col);
- foreach $col ( $table->columns ) {
- next if $col =~ /^svcnum$/;
- $part_svc->addcolumn( new FS::dbdef_column (
- $table->name. '__' . $table->column($col)->name,
- 'varchar', #$table->column($col)->type,
- 'NULL',
- $char_d, #$table->column($col)->length,
- ));
- $part_svc->addcolumn ( new FS::dbdef_column (
- $table->name. '__'. $table->column($col)->name . "_flag",
- 'char',
- 'NULL',
- 1,
- ));
- }
+foreach $attribute (@check_attributes) {
+ $svc_acct->addcolumn( new DBIx::DBSchema::Column (
+ 'rc_'. $attribute,
+ 'varchar',
+ 'NULL',
+ $char_d,
+ ));
+}
+
+##make part_svc table (but now as object)
+#
+#my($part_svc)=$dbdef->table('part_svc');
+#
+##because of svc_acct_pop
+##foreach (grep /^svc_/, $dbdef->tables) {
+##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
+#foreach (qw(svc_acct svc_domain svc_forward svc_www)) {
+# my($table)=$dbdef->table($_);
+# my($col);
+# foreach $col ( $table->columns ) {
+# next if $col =~ /^svcnum$/;
+# $part_svc->addcolumn( new DBIx::DBSchema::Column (
+# $table->name. '__' . $table->column($col)->name,
+# 'varchar', #$table->column($col)->type,
+# 'NULL',
+# $char_d, #$table->column($col)->length,
+# ));
+# $part_svc->addcolumn ( new DBIx::DBSchema::Column (
+# $table->name. '__'. $table->column($col)->name . "_flag",
+# 'char',
+# 'NULL',
+# 1,
+# ));
+# }
+#}
+
+#create history tables (false laziness w/create-history-tables)
+foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) {
+ my $tableobj = $dbdef->table($table)
+ or die "unknown table $table";
+
+ my $h_tableobj = DBIx::DBSchema::Table->new( {
+ name => "h_$table",
+ primary_key => 'historynum',
+ unique => DBIx::DBSchema::ColGroup::Unique->new( [] ),
+ 'index' => DBIx::DBSchema::ColGroup::Index->new( [
+ @{$tableobj->unique->lol_ref},
+ @{$tableobj->index->lol_ref}
+ ] ),
+ columns => [
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'historynum',
+ 'type' => 'serial',
+ 'null' => 'NOT NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_date',
+ 'type' => 'int',
+ 'null' => 'NULL',
+ 'length' => '',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_user',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ DBIx::DBSchema::Column->new( {
+ 'name' => 'history_action',
+ 'type' => 'varchar',
+ 'null' => 'NOT NULL',
+ 'length' => '80',
+ 'default' => '',
+ 'local' => '',
+ } ),
+ map { $tableobj->column($_) } $tableobj->columns
+ ],
+ } );
+ $dbdef->addtable($h_tableobj);
}
#important
$dbdef->save($dbdef_file);
-FS::Record::reload_dbdef;
+&FS::Record::reload_dbdef($dbdef_file);
###
# create 'em
###
-my($dbh)=adminsuidsetup;
+my($dbh)=adminsuidsetup $user;
#create tables
$|=1;
-my($table);
-foreach ($dbdef->tables) {
- my($table)=$dbdef->table($_);
- print "Creating $_...";
-
- my($statement);
-
- #create table
- foreach $statement ($table->sql_create_table(datasrc)) {
- #print $statement, "\n";
- $dbh->do( $statement )
- or die "CREATE error: ",$dbh->errstr, "\ndoing statement: $statement";
- }
-
- print "\n";
+foreach my $statement ( $dbdef->sql($dbh) ) {
+ $dbh->do( $statement )
+ or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement";
}
#not really sample data (and shouldn't default to US)
#cust_main_county
+
+#USPS state codes
foreach ( qw(
AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
-SC SD TN TX TT UT VT VI VA WA WV WI WY AE AA AP
+SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP
) ) {
- my($cust_main_county)=create FS::cust_main_county({
+ my($cust_main_county)=new FS::cust_main_county({
'state' => $_,
'tax' => 0,
+ 'country' => 'US',
});
my($error);
$error=$cust_main_county->insert;
die $error if $error;
}
+#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson)
+foreach ( qw(
+VIC NSW NT QLD TAS ACT WA SA
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'state' => $_,
+ 'tax' => 0,
+ 'country' => 'AU',
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#ISO 2-letter country codes (same as country TLDs) except US and AU
+foreach ( qw(
+AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO
+BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI
+HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA
+GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL
+IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV
+ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG
+NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM
+ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ
+TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH
+YE YU ZR ZM ZW
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'tax' => 0,
+ 'country' => $_,
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#billing events
+foreach my $aref (
+ [ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ],
+ [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ],
+ [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
+) {
+
+ my $part_bill_event = new FS::part_bill_event({
+ 'payby' => $aref->[0],
+ 'event' => $aref->[1],
+ 'eventcode' => $aref->[2],
+ 'seconds' => 0,
+ 'weight' => $aref->[3],
+ 'plan' => $aref->[4],
+ });
+ my($error);
+ $error=$part_bill_event->insert;
+ die $error if $error;
+
+}
+
+$dbh->commit or die $dbh->errstr;
$dbh->disconnect or die $dbh->errstr;
+print "Freeside database initialized sucessfully\n";
+
+sub usage {
+ die "Usage:\n fs-setup user\n";
+}
+
###
# Now it becomes an object. much better.
###
'agentnum', 'int', '', '',
'agent', 'varchar', '', $char_d,
'typenum', 'int', '', '',
- 'freq', 'smallint', 'NULL', '',
+ 'freq', 'int', 'NULL', '',
'prog', @perl_type,
],
'primary_key' => 'agentnum',
'custnum', 'int', '', '',
'_date', @date_type,
'charged', @money_type,
- 'owed', @money_type,
'printed', 'int', '', '',
+ 'closed', 'char', 'NULL', 1,
],
'primary_key' => 'invnum',
'unique' => [ [] ],
'index' => [ ['custnum'] ],
},
+ 'cust_bill_event' => {
+ 'columns' => [
+ 'eventnum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'eventpart', 'int', '', '',
+ '_date', @date_type,
+ 'status', 'varchar', '', $char_d,
+ 'statustext', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'eventnum',
+ #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ],
+ 'unique' => [],
+ 'index' => [ ['invnum'], ['status'] ],
+ },
+
+ 'part_bill_event' => {
+ 'columns' => [
+ 'eventpart', 'int', '', '',
+ 'payby', 'char', '', 4,
+ 'event', 'varchar', '', $char_d,
+ 'eventcode', @perl_type,
+ 'seconds', 'int', 'NULL', '',
+ 'weight', 'int', '', '',
+ 'plan', 'varchar', 'NULL', $char_d,
+ 'plandata', 'text', 'NULL', '',
+ 'disabled', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'eventpart',
+ 'unique' => [ [] ],
+ 'index' => [ ['payby'] ],
+ },
+
'cust_bill_pkg' => {
'columns' => [
'pkgnum', 'int', '', '',
'custnum', 'int', '', '',
'_date', @date_type,
'amount', @money_type,
- 'credited', @money_type,
'otaker', 'varchar', '', 8,
- 'reason', 'varchar', '', 255,
+ 'reason', 'text', 'NULL', '',
+ 'closed', 'char', 'NULL', 1,
],
'primary_key' => 'crednum',
'unique' => [ [] ],
'index' => [ ['custnum'] ],
},
+ 'cust_credit_bill' => {
+ 'columns' => [
+ 'creditbillnum', 'int', '', '',
+ 'crednum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ '_date', @date_type,
+ 'amount', @money_type,
+ ],
+ 'primary_key' => 'creditbillnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['crednum'], ['invnum'] ],
+ },
+
'cust_main' => {
'columns' => [
'custnum', 'int', '', '',
'agentnum', 'int', '', '',
+# 'titlenum', 'int', 'NULL', '',
'last', 'varchar', '', $char_d,
+# 'middle', 'varchar', 'NULL', $char_d,
'first', 'varchar', '', $char_d,
'ss', 'char', 'NULL', 11,
'company', 'varchar', 'NULL', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
'county', 'varchar', 'NULL', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', 'NULL', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
'daytime', 'varchar', 'NULL', 20,
'night', 'varchar', 'NULL', 20,
'fax', 'varchar', 'NULL', 12,
+ 'ship_last', 'varchar', 'NULL', $char_d,
+# 'ship_middle', 'varchar', 'NULL', $char_d,
+ 'ship_first', 'varchar', 'NULL', $char_d,
+ 'ship_company', 'varchar', 'NULL', $char_d,
+ 'ship_address1', 'varchar', 'NULL', $char_d,
+ 'ship_address2', 'varchar', 'NULL', $char_d,
+ 'ship_city', 'varchar', 'NULL', $char_d,
+ 'ship_county', 'varchar', 'NULL', $char_d,
+ 'ship_state', 'varchar', 'NULL', $char_d,
+ 'ship_zip', 'varchar', 'NULL', 10,
+ 'ship_country', 'char', 'NULL', 2,
+ 'ship_daytime', 'varchar', 'NULL', 20,
+ 'ship_night', 'varchar', 'NULL', 20,
+ 'ship_fax', 'varchar', 'NULL', 12,
'payby', 'char', '', 4,
- 'payinfo', 'varchar', 'NULL', 16,
- 'paydate', @date_type,
+ 'payinfo', 'varchar', 'NULL', $char_d,
+ #'paydate', @date_type,
+ 'paydate', 'varchar', 'NULL', 10,
'payname', 'varchar', 'NULL', $char_d,
'tax', 'char', 'NULL', 1,
'otaker', 'varchar', '', 8,
'refnum', 'int', '', '',
+ 'referral_custnum', 'int', 'NULL', '',
+ 'comments', 'text', 'NULL', '',
],
'primary_key' => 'custnum',
'unique' => [ [] ],
#'index' => [ ['last'], ['company'] ],
- 'index' => [ ['last'], ],
+ 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ] ],
+ },
+
+ 'cust_main_invoice' => {
+ 'columns' => [
+ 'destnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'dest', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'destnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['custnum'], ],
},
- 'cust_main_county' => { #county+state are checked off the cust_main_county
- #table for validation and to provide a tax rate.
- #add country?
+ 'cust_main_county' => { #county+state+country are checked off the
+ #cust_main_county for validation and to provide
+ # a tax rate.
'columns' => [
'taxnum', 'int', '', '',
- 'state', 'char', '', 2, #two letters max in US... elsewhere?
- 'county', 'varchar', '', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'country', 'char', '', 2,
+ 'taxclass', 'varchar', 'NULL', $char_d,
+ 'exempt_amount', @money_type,
'tax', 'real', '', '', #tax %
],
'primary_key' => 'taxnum',
'cust_pay' => {
'columns' => [
'paynum', 'int', '', '',
- 'invnum', 'int', '', '',
+ #now cust_bill_pay #'invnum', 'int', '', '',
+ 'custnum', 'int', '', '',
'paid', @money_type,
'_date', @date_type,
'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into
# payment type table.
'payinfo', 'varchar', 'NULL', 16, #see cust_main above
'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes.
+ 'closed', 'char', 'NULL', 1,
],
'primary_key' => 'paynum',
'unique' => [ [] ],
- 'index' => [ ['invnum'] ],
+ 'index' => [ [ 'custnum' ], [ 'paybatch' ] ],
+ },
+
+ 'cust_bill_pay' => {
+ 'columns' => [
+ 'billpaynum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'paynum', 'int', '', '',
+ 'amount', @money_type,
+ '_date', @date_type
+ ],
+ 'primary_key' => 'billpaynum',
+ 'unique' => [ [] ],
+ 'index' => [ [ 'paynum' ], [ 'invnum' ] ],
},
'cust_pay_batch' => { #what's this used for again? list of customers
#in current CARD batch? (necessarily CARD?)
'columns' => [
+ 'paybatchnum', 'int', '', '',
'invnum', 'int', '', '',
'custnum', 'int', '', '',
'last', 'varchar', '', $char_d,
'address1', 'varchar', '', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', '', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
- 'trancode', 'TINYINT', '', '',
+# 'trancode', 'int', '', '',
'cardnum', 'varchar', '', 16,
- 'exp', @date_type,
+ #'exp', @date_type,
+ 'exp', 'varchar', '', 11,
'payname', 'varchar', 'NULL', $char_d,
'amount', @money_type,
],
- 'primary_key' => '',
+ 'primary_key' => 'paybatchnum',
'unique' => [ [] ],
'index' => [ ['invnum'], ['custnum'] ],
},
'susp', @date_type,
'cancel', @date_type,
'expire', @date_type,
+ 'manual_flag', 'char', 'NULL', 1,
],
'primary_key' => 'pkgnum',
'unique' => [ [] ],
'cust_refund' => {
'columns' => [
'refundnum', 'int', '', '',
- 'crednum', 'int', '', '',
+ #now cust_credit_refund #'crednum', 'int', '', '',
+ 'custnum', 'int', '', '',
'_date', @date_type,
'refund', @money_type,
'otaker', 'varchar', '', 8,
'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
# into payment type table.
'payinfo', 'varchar', 'NULL', 16, #see cust_main above
+ 'paybatch', 'varchar', 'NULL', $char_d,
+ 'closed', 'char', 'NULL', 1,
],
'primary_key' => 'refundnum',
'unique' => [ [] ],
- 'index' => [ ['crednum'] ],
+ 'index' => [ [] ],
},
+ 'cust_credit_refund' => {
+ 'columns' => [
+ 'creditrefundnum', 'int', '', '',
+ 'crednum', 'int', '', '',
+ 'refundnum', 'int', '', '',
+ 'amount', @money_type,
+ '_date', @date_type
+ ],
+ 'primary_key' => 'creditrefundnum',
+ 'unique' => [ [] ],
+ 'index' => [ [ 'crednum', 'refundnum' ] ],
+ },
+
+
'cust_svc' => {
'columns' => [
'svcnum', 'int', '', '',
- 'pkgnum', 'int', '', '',
+ 'pkgnum', 'int', 'NULL', '',
'svcpart', 'int', '', '',
],
'primary_key' => 'svcnum',
'pkg', 'varchar', '', $char_d,
'comment', 'varchar', '', $char_d,
'setup', @perl_type,
- 'freq', 'smallint', '', '', #billing frequency (months)
+ 'freq', 'int', '', '', #billing frequency (months)
'recur', @perl_type,
+ 'setuptax', 'char', 'NULL', 1,
+ 'recurtax', 'char', 'NULL', 1,
+ 'plan', 'varchar', 'NULL', $char_d,
+ 'plandata', 'text', 'NULL', '',
+ 'disabled', 'char', 'NULL', 1,
+ 'taxclass', 'varchar', 'NULL', $char_d,
],
'primary_key' => 'pkgpart',
'unique' => [ [] ],
'index' => [ [] ],
},
+# 'part_title' => {
+# 'columns' => [
+# 'titlenum', 'int', '', '',
+# 'title', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'titlenum',
+# 'unique' => [ [] ],
+# 'index' => [ [] ],
+# },
+
'pkg_svc' => {
'columns' => [
'pkgpart', 'int', '', '',
'svcpart', 'int', '', '',
'svc', 'varchar', '', $char_d,
'svcdb', 'varchar', '', $char_d,
+ 'disabled', 'char', 'NULL', 1,
],
'primary_key' => 'svcpart',
'unique' => [ [] ],
'index' => [ [] ],
},
+ 'part_svc_column' => {
+ 'columns' => [
+ 'columnnum', 'int', '', '',
+ 'svcpart', 'int', '', '',
+ 'columnname', 'varchar', '', 64,
+ 'columnvalue', 'varchar', 'NULL', $char_d,
+ 'columnflag', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'columnnum',
+ 'unique' => [ [ 'svcpart', 'columnname' ] ],
+ 'index' => [ [ 'svcpart' ] ],
+ },
+
#(this should be renamed to part_pop)
'svc_acct_pop' => {
'columns' => [
'popnum', 'int', '', '',
'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', '', $char_d,
'ac', 'char', '', 3,
'exch', 'char', '', 3,
- #rest o' number?
+ 'loc', 'char', 'NULL', 4, #NULL for legacy purposes
],
'primary_key' => 'popnum',
'unique' => [ [] ],
- 'index' => [ [] ],
+ 'index' => [ [ 'state' ] ],
+ },
+
+ 'part_pop_local' => {
+ 'columns' => [
+ 'localnum', 'int', '', '',
+ 'popnum', 'int', '', '',
+ 'city', 'varchar', 'NULL', $char_d,
+ 'state', 'char', 'NULL', 2,
+ 'npa', 'char', '', 3,
+ 'nxx', 'char', '', 3,
+ ],
+ 'primary_key' => 'localnum',
+ 'unique' => [ [] ],
+ 'index' => [ [ 'npa', 'nxx' ], [ 'popnum' ] ],
},
'svc_acct' => {
'columns' => [
'svcnum', 'int', '', '',
'username', 'varchar', '', $username_len, #unique (& remove dup code)
- '_password', 'varchar', '', 25, #13 for encryped pw's plus ' *SUSPENDED*
+ '_password', 'varchar', '', 50, #13 for encryped pw's plus ' *SUSPENDED* (mp5 passwords can be 34)
+ 'sec_phrase', 'varchar', 'NULL', $char_d,
'popnum', 'int', 'NULL', '',
- 'uid', 'bigint', 'NULL', '',
- 'gid', 'bigint', 'NULL', '',
+ 'uid', 'int', 'NULL', '',
+ 'gid', 'int', 'NULL', '',
'finger', 'varchar', 'NULL', $char_d,
'dir', 'varchar', 'NULL', $char_d,
'shell', 'varchar', 'NULL', $char_d,
'quota', 'varchar', 'NULL', $char_d,
'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
+ 'seconds', 'int', 'NULL', '', #uhhhh
+ 'domsvc', 'int', '', '',
],
'primary_key' => 'svcnum',
- 'unique' => [ [] ],
- 'index' => [ ['username'] ],
+ 'unique' => [ [ 'username', 'domsvc' ] ],
+ 'index' => [ ['username'], ['domsvc'] ],
},
- 'svc_acct_sm' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'domsvc', 'int', '', '',
- 'domuid', 'bigint', '', '',
- 'domuser', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ [] ],
- 'index' => [ ['domsvc'], ['domuid'] ],
- },
+# 'svc_acct_sm' => {
+# 'columns' => [
+# 'svcnum', 'int', '', '',
+# 'domsvc', 'int', '', '',
+# 'domuid', 'int', '', '',
+# 'domuser', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'svcnum',
+# 'unique' => [ [] ],
+# 'index' => [ ['domsvc'], ['domuid'] ],
+# },
#'svc_charge' => {
# 'columns' => [
'columns' => [
'svcnum', 'int', '', '',
'domain', 'varchar', '', $char_d,
+ 'catchall', 'int', 'NULL', '',
],
'primary_key' => 'svcnum',
'unique' => [ ['domain'] ],
'index' => [ [] ],
},
+ 'domain_record' => {
+ 'columns' => [
+ 'recnum', 'int', '', '',
+ 'svcnum', 'int', '', '',
+ 'reczone', 'varchar', '', $char_d,
+ 'recaf', 'char', '', 2,
+ 'rectype', 'char', '', 5,
+ 'recdata', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'recnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['svcnum'] ],
+ },
+
+ 'svc_forward' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'srcsvc', 'int', '', '',
+ 'dstsvc', 'int', '', '',
+ 'dst', 'varchar', 'NULL', $char_d,
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['srcsvc'], ['dstsvc'] ],
+ },
+
+ 'svc_www' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'recnum', 'int', '', '',
+ 'usersvc', 'int', '', '',
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ [] ],
+ 'index' => [ [] ],
+ },
+
#'svc_wo' => {
# 'columns' => [
# 'svcnum', 'int', '', '',
# 'index' => [ [] ],
#},
+ 'prepay_credit' => {
+ 'columns' => [
+ 'prepaynum', 'int', '', '',
+ 'identifier', 'varchar', '', $char_d,
+ 'amount', @money_type,
+ 'seconds', 'int', 'NULL', '',
+ ],
+ 'primary_key' => 'prepaynum',
+ 'unique' => [ ['identifier'] ],
+ 'index' => [ [] ],
+ },
+
+ 'port' => {
+ 'columns' => [
+ 'portnum', 'int', '', '',
+ 'ip', 'varchar', 'NULL', 15,
+ 'nasport', 'int', 'NULL', '',
+ 'nasnum', 'int', '', '',
+ ],
+ 'primary_key' => 'portnum',
+ 'unique' => [],
+ 'index' => [],
+ },
+
+ 'nas' => {
+ 'columns' => [
+ 'nasnum', 'int', '', '',
+ 'nas', 'varchar', '', $char_d,
+ 'nasip', 'varchar', '', 15,
+ 'nasfqdn', 'varchar', '', $char_d,
+ 'last', 'int', '', '',
+ ],
+ 'primary_key' => 'nasnum',
+ 'unique' => [ [ 'nas' ], [ 'nasip' ] ],
+ 'index' => [ [ 'last' ] ],
+ },
+
+ 'session' => {
+ 'columns' => [
+ 'sessionnum', 'int', '', '',
+ 'portnum', 'int', '', '',
+ 'svcnum', 'int', '', '',
+ 'login', @date_type,
+ 'logout', @date_type,
+ ],
+ 'primary_key' => 'sessionnum',
+ 'unique' => [],
+ 'index' => [ [ 'portnum' ] ],
+ },
+
+ 'queue' => {
+ 'columns' => [
+ 'jobnum', 'int', '', '',
+ 'job', 'text', '', '',
+ '_date', 'int', '', '',
+ 'status', 'varchar', '', $char_d,
+ 'statustext', 'text', 'NULL', '',
+ 'svcnum', 'int', 'NULL', '',
+ ],
+ 'primary_key' => 'jobnum',
+ 'unique' => [],
+ 'index' => [ [ 'svcnum' ], [ 'status' ] ],
+ },
+
+ 'queue_arg' => {
+ 'columns' => [
+ 'argnum', 'int', '', '',
+ 'jobnum', 'int', '', '',
+ 'arg', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'argnum',
+ 'unique' => [],
+ 'index' => [ [ 'jobnum' ] ],
+ },
+
+ 'queue_depend' => {
+ 'columns' => [
+ 'dependnum', 'int', '', '',
+ 'jobnum', 'int', '', '',
+ 'depend_jobnum', 'int', '', '',
+ ],
+ 'primary_key' => 'dependnum',
+ 'unique' => [],
+ 'index' => [ [ 'jobnum' ], [ 'depend_jobnum' ] ],
+ },
+
+ 'export_svc' => {
+ 'columns' => [
+ 'exportsvcnum' => 'int', '', '',
+ 'exportnum' => 'int', '', '',
+ 'svcpart' => 'int', '', '',
+ ],
+ 'primary_key' => 'exportsvcnum',
+ 'unique' => [ [ 'exportnum', 'svcpart' ] ],
+ 'index' => [ [ 'exportnum' ], [ 'svcpart' ] ],
+ },
+
+ 'part_export' => {
+ 'columns' => [
+ 'exportnum', 'int', '', '',
+ #'svcpart', 'int', '', '',
+ 'machine', 'varchar', '', $char_d,
+ 'exporttype', 'varchar', '', $char_d,
+ 'nodomain', 'char', 'NULL', 1,
+ ],
+ 'primary_key' => 'exportnum',
+ 'unique' => [],
+ 'index' => [ [ 'machine' ], [ 'exporttype' ] ],
+ },
+
+ 'part_export_option' => {
+ 'columns' => [
+ 'optionnum', 'int', '', '',
+ 'exportnum', 'int', '', '',
+ 'optionname', 'varchar', '', $char_d,
+ 'optionvalue', 'text', 'NULL', '',
+ ],
+ 'primary_key' => 'optionnum',
+ 'unique' => [],
+ 'index' => [ [ 'exportnum' ], [ 'optionname' ] ],
+ },
+
+ 'radius_usergroup' => {
+ 'columns' => [
+ 'usergroupnum', 'int', '', '',
+ 'svcnum', 'int', '', '',
+ 'groupname', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'usergroupnum',
+ 'unique' => [],
+ 'index' => [ [ 'svcnum' ], [ 'groupname' ] ],
+ },
+
+ 'msgcat' => {
+ 'columns' => [
+ 'msgnum', 'int', '', '',
+ 'msgcode', 'varchar', '', $char_d,
+ 'locale', 'varchar', '', 16,
+ 'msg', 'text', '', '',
+ ],
+ 'primary_key' => 'msgnum',
+ 'unique' => [ [ 'msgcode', 'locale' ] ],
+ 'index' => [],
+ },
+
+ 'cust_tax_exempt' => {
+ 'columns' => [
+ 'exemptnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'taxnum', 'int', '', '',
+ 'year', 'int', '', '',
+ 'month', 'int', '', '',
+ 'amount', @money_type,
+ ],
+ 'primary_key' => 'exemptnum',
+ 'unique' => [ [ 'custnum', 'taxnum', 'year', 'month' ] ],
+ 'index' => [],
+ },
+
+
+
);
%tables;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::prepay_credit;
+
+require 5.004; #srand(time|$$);
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $amount = shift or die &usage;
+
+my $seconds = shift or die &usage;
+
+my $num_digits = shift or die &usage;
+
+my $num_entries = shift or die &usage;
+
+for ( 1 .. $num_entries ) {
+ my $identifier = join( '', map int(rand(10)), ( 1 .. $num_digits ) );
+ my $prepay_credit = new FS::prepay_credit {
+ 'identifier' => $identifier,
+ 'amount' => $amount,
+ 'seconds' => $seconds,
+ };
+ my $error = $prepay_credit->insert;
+ die $error if $error;
+ print "$identifier\n";
+}
+
+sub usage {
+ die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries";
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+# usage: generate-raddb radius-server/raddb/dictionary* >raddb.pm
+# i.e.: generate-raddb ~/src/freeradius-0.2/raddb/dictionary* >FS/raddb.pm
+
+print <<END;
+package FS::raddb;
+use vars qw(%attrib);
+
+%attrib = (
+END
+
+while (<>) {
+ next if /^(#|\s*$|\$INCLUDE\s+)/;
+ next if /^(VALUE|VENDOR|BEGIN\-VENDOR|END\-VENDOR)\s+/;
+ /^(ATTRIBUTE|ATTRIB_NMC)\s+([\w\-]+)\s+/ or die $_;
+ $attrib = $2;
+ $dbname = lc($2);
+ $dbname =~ s/\-/_/g;
+ $hash{$dbname} = $attrib;
+ #print "$2\n";
+}
+
+foreach ( keys %hash ) {
+# print "$_\n" if length($_)>24;
+# print substr($_,0,24),"\n" if length($_)>24;
+# $max = length($_) if length($_)>$max;
+#everything >24 is still unique, at least with freeradius comprehensive dataset
+ print " '". substr($_,0,24). "' => '$hash{$_}',\n";
+}
+
+print <<END;
+);
+
+1;
+END
+
--- /dev/null
+#!/usr/bin/perl
+@files = glob('FS/*.pm');
+foreach (@files) {
+# warn $_;
+ chomp;
+ s/^FS\///;
+ $f=$_;
+ $f=~s/pm$/t/;
+ $m=$_;
+ $m=~s/\.pm$//;
+ open(TEST,">t/$f");
+ print "t/$f\n";
+ print TEST
+ 'BEGIN { $| = 1; print "1..1\n" }'. "\n".
+ 'END {print "not ok 1\n" unless $loaded;}'. "\n".
+ "use FS::$m;\n".
+ '$loaded=1;'. "\n".
+ 'print "ok 1\n";'. "\n"
+ ;
+ close TEST;
+}
--- /dev/null
+#!/usr/bin/perl
+
+foreach $file ( split(/\n/, `find . -depth -print | grep cgi\$`) ) {
+ open(F,$file) or die "can't open $file for reading: $!";
+ @file = <F>;
+ #print "$file ". scalar(@file). "\n";
+ close $file;
+ system("chmod u+w $file");
+ open(W,">$file") or die "can't open $file for writing: $!";
+ select W; $| = 1; select STDOUT;
+ $all = join('',@file);
+
+ $mode = 'html';
+ while ( length($all) ) {
+
+ if ( $mode eq 'html' ) {
+
+ if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) {
+ print W $1;
+ $all = $2;
+ next;
+ } elsif ( $all =~ /^<%=(.*)$/s ) {
+ print W '<%';
+ $all = $1;
+ $mode = 'perlv';
+ #die;
+ next;
+ } elsif ( $all =~ /^<%(.*)$/s ) {
+ print W "\n";
+ $all = $1;
+ $mode = 'perlc';
+ next;
+ } elsif ( $all !~ /<%/s ) {
+ print W $all;
+ last;
+ } else {
+ warn length($all); die;
+ }
+ die;
+
+ } elsif ( $mode eq 'perlv' ) {
+
+ if ( $all =~ /^(.*?%>)(.*)$/s ) {
+ print W $1;
+ $all=$2;
+ $mode = 'html';
+ next;
+ }
+ die 'unterminated <%= ???';
+
+ } elsif ( $mode eq 'perlc' ) {
+
+ if ( $all =~ /^([^\n]*?)%>(.*)$/s ) {
+ print W "%$1\n";
+ $all=$2;
+ $mode='html';
+ next;
+ }
+ if ( $all =~ /^([^\n]*)\n(.*)$/s ) {
+ print W "%$1\n";
+ $all=$2;
+ next;
+ }
+
+ } else { die };
+
+ }
+
+ close W;
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+# $Id: passwd.import,v 1.1 2002-04-20 11:57:35 ivan Exp $
+
+use strict;
+use vars qw(%part_svc);
+use Date::Parse;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch);
+use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shuddown /bin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+#$FS::svc_acct::nossh_hack = 1;
+$FS::svc_acct::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my($shell_svcpart)=&getpart;
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ passwd file, for example
+"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
+END
+my($loc_passwd)=&getvalue(":");
+iscp("root\@$loc_passwd", "$spooldir/passwd.import");
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(PASSWD,"<$spooldir/passwd.import");
+open(SHADOW,"<$spooldir/shadow.import");
+
+my(%password);
+while (<SHADOW>) {
+ chop;
+ my($username,$password)=split(/:/);
+ #$password =~ s/^\!$/\*/;
+ #$password =~ s/\!+/\*SUSPENDED\* /;
+ $password{$username}=$password;
+}
+
+while (<PASSWD>) {
+ chop;
+ my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/);
+ my($password)=$upassword{$username} || $password{$username};
+
+ $svcpart = $shell_svcpart;
+
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'uid' => $uid,
+ 'gid' => $gid,
+ 'finger' => $finger,
+ 'dir' => $dir,
+ 'shell' => $shell,
+ %{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ die $error if $error;
+
+ delete $upassword{$username};
+}
+
+sub usage {
+ die "Usage:\n\n passwd.import user\n";
+}
+
#use Pod::Text;
#$Pod::Text::termcap=1;
-my $site_perl = "./site_perl";
+my $site_perl = "./FS";
#my $catman = "./catman";
-my $catman = "./htdocs/docs/man";
+#my $catman = "./htdocs/docs/man";
#my $html = "./htdocs/docs/man";
+my $html = "./httemplate/docs/man";
$|=1;
-die "Can't find $site_perl and $catman"
- unless [ -d $site_perl ] && [ -d $catman ] && [ -d $html ];
+die "Can't find $site_perl" unless -d $site_perl;
+#die "Can't find $catman" unless -d $catman;
+die "Can't find $html" unless -d $html;
-foreach my $file (glob("$site_perl/*.pm")) {
- $file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
- my $name = $1;
- print "$name\n";
- system "pod2text $file >$catman/$name.txt";
-# system "pod2html --podpath=$site_perl $file >$html/$name.html";
+#make some useless links
+foreach my $file (
+ glob("$site_perl/bin/freeside-*"),
+) {
+ next if $file =~ /\.pod$/;
+ #symlink $file, "$file.pod"; # or die "link $file to $file.pod: $!";
+ system("cp $file $file.pod");
+}
+
+foreach my $file (
+ glob("$site_perl/*.pm"),
+ glob("$site_perl/*/*.pm"),
+ glob("$site_perl/*/*/*.pm"),
+ glob("$site_perl/bin/*.pod"),
+ glob("./fs_sesmon/FS-SessionClient/*.pm"),
+ glob("./fs_signup/FS-SignupClient/*.pm"),
+ glob("./fs_selfadmin/FS-MailAdminServer/*.pm"),
+) {
+ next if $file =~ /^blib\//;
+ #$file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
+ my $name;
+ if ( $file =~ /fs_\w+\/FS\-\w+\/(.*)\.pm$/ ) {
+ $name = "FS/$1";
+ } elsif ( $file =~ /$site_perl\/(.*)\.(pm|pod)$/ ) {
+ $name = $1;
+ } else {
+ die "oops file $file";
+ }
+ print "$name\n";
+ my $htmlroot = join('/', map '..',1..(scalar($file =~ tr/\///)-2)) || '.';
+# system "pod2text $file >$catman/$name.txt";
+ system "pod2html --podroot=$site_perl --podpath=./FS:./FS/UI:.:./bin --norecurse --htmlroot=$htmlroot $file >$html/$name.html";
+ #system "pod2html --podroot=$site_perl --htmlroot=$htmlroot $file >$html/$name.html";
# system "pod2html $file >$html/$name.html";
}
+
+#remove the useless links
+unlink glob("$site_perl/bin/*.pod");
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::msgcat;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+foreach my $del_msgcat ( qsearch('msgcat', {}) ) {
+ my $error = $del_msgcat->delete;
+ die $error if $error;
+}
+
+my %messages = messages();
+
+foreach my $msgcode ( keys %messages ) {
+ foreach my $locale ( keys %{$messages{$msgcode}} ) {
+ my $msgcat = new FS::msgcat( {
+ 'msgcode' => $msgcode,
+ 'locale' => $locale,
+ 'msg' => $messages{$msgcode}{$locale},
+ });
+ my $error = $msgcat->insert;
+ die $error if $error;
+ }
+}
+
+print "Message catalog initialized sucessfully\n";
+
+sub messages {
+
+ # 'msgcode' => {
+ # 'en_US' => 'Message',
+ # },
+
+ (
+
+ 'passwords_dont_match' => {
+ 'en_US' => "Passwords don't match",
+ },
+
+ 'invalid_card' => {
+ 'en_US' => 'Invalid credit card number',
+ },
+
+ 'unknown_card_type' => {
+ 'en_US' => 'Unknown card type',
+ },
+
+ 'not_a' => {
+ 'en_US' => 'Not a ',
+ },
+
+ 'empty_password' => {
+ 'en_US' => 'Empty password',
+ },
+
+ 'no_access_number_selected' => {
+ 'en_US' => 'No access number selected',
+ },
+
+ 'illegal_text' => {
+ 'en_US' => 'Illegal (text)',
+ #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in field',
+ },
+
+ 'illegal_or_empty_text' => {
+ 'en_US' => 'Illegal or empty (text)',
+ #'en_US' => 'Only letters, numbers, spaces, and the following punctuation symbols are permitted: ! @ # $ % & ( ) - + ; : \' " , . ? / in required field',
+ },
+
+ 'illegal_username' => {
+ 'en_US' => 'Illegal username',
+ },
+
+ 'illegal_password' => {
+ 'en_US' => 'Illegal password',
+ },
+
+ 'username_in_use' => {
+ 'en_US' => 'Username in use',
+ },
+
+ 'illegal_email_invoice_address' => {
+ 'en_US' => 'Illegal email invoice address',
+ },
+
+ 'illegal_name' => {
+ 'en_US' => 'Illegal (name)',
+ #'en_US' => 'Only letters, numbers, spaces and the following punctuation symbols are permitted: , . - \' in field',
+ },
+
+ 'illegal_phone' => {
+ 'en_US' => 'Illegal (phone)',
+ #'en_US' => '',
+ },
+
+ 'illegal_zip' => {
+ 'en_US' => 'Illegal (zip)',
+ #'en_US' => '',
+ },
+
+ 'expired_card' => {
+ 'en_US' => 'Expired card',
+ },
+
+ );
+}
+
+sub usage {
+ die "Usage:\n\n populate-msgcat user\n";
+}
+
-#!/usr/bin/perl -Tw
+#!/usr/bin/perl -w
#
-# Create and export password files: passwd, passwd.adjunct, shadow,
-# acp_passwd, acp_userinfo, acp_dialup, users
+# $Id: svc_acct.export,v 1.36 2002-05-16 14:28:35 ivan Exp $
#
-# ivan@voicenet.com late august/september 96
-# (the password encryption bits were from melody)
-#
-# use a temporary copy of svc_acct to minimize lock time on the real file,
-# and skip blank entries.
-#
-# ivan@voicenet.com 96-Oct-6
-#
-# change users / acp_dialup file formats
-# ivan@voicenet.com 97-jan-28-31
-#
-# change priority (after copies) to 19, not 10
-# ivan@voicenet.com 97-feb-5
-#
-# added exit if stuff is already locked 97-apr-15
-#
-# rewrite ivan@sisd.com 98-mar-9
-#
-# Changed 'password' to '_password' because Pg6.3 reserves this word
-# Added code to create a FreeBSD style master.passwd file
-# bmccane@maxbaud.net 98-Apr-3
-#
-# don't export non-root 0 UID's, even if they get put in the database
-# ivan@sisd.com 98-jul-14
-#
-# Uses Idle_Timeout, Port_Limit, Framed_Netmask and Framed_Route if they
-# exist; need some way to support arbitrary radius fields. also
-# /var/spool/freeside/conf/ ivan@sisd.com 98-jul-26, aug-9
-#
-# OOPS! added arbitrary radius fields (pry 98-aug-16) but forgot to say so.
-# ivan@sisd.com 98-sep-18
+# Create and export password, radius and vpopmail password files:
+# passwd, passwd.adjunct, shadow, acp_passwd, acp_userinfo, acp_dialup
+# users/assign, domains/vdomain/vpasswd
+# Also export sendmail and qmail config files.
use strict;
+use vars qw($conf);
use Fcntl qw(:flock);
-use FS::SSH qw(scp ssh);
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearch fields);
-
-my($fshellmachines)="/var/spool/freeside/conf/shellmachines";
-my(@shellmachines);
-if ( -e $fshellmachines ) {
- open(SHELLMACHINES,$fshellmachines);
- @shellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/shellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SHELLMACHINES>;
- close SHELLMACHINES;
-}
+use File::Path;
+use IO::Handle;
+use FS::Conf;
+use Net::SSH qw(ssh);
+use Net::SCP qw(scp);
+use FS::UID qw(adminsuidsetup datasrc dbh);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct;
+use FS::svc_domain;
+use FS::svc_forward;
-my($fbsdshellmachines)="/var/spool/freeside/conf/bsdshellmachines";
-my(@bsdshellmachines);
-if ( -e $fbsdshellmachines ) {
- open(BSDSHELLMACHINES,$fbsdshellmachines);
- @bsdshellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/bsdshellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <BSDSHELLMACHINES>;
- close BSDSHELLMACHINES;
-}
+my $ssh='ssh';
+my $rsync='rsync';
-my($fnismachines)="/var/spool/freeside/conf/nismachines";
-my(@nismachines);
-if ( -e $fnismachines ) {
- open(NISMACHINES,$fnismachines);
- @nismachines=map {
- /^(.*)$/ or die "Illegal line in conf/nismachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <NISMACHINES>;
- close NISMACHINES;
-}
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$conf = new FS::Conf;
+
+my $userpolicy = $conf->config('username_policy')
+ if $conf->exists('username_policy');
+
+my @shellmachines = $conf->config('shellmachines')
+ if $conf->exists('shellmachines');
+
+my @bsdshellmachines = $conf->config('bsdshellmachines')
+ if $conf->exists('bsdshellmachines');
+
+my @nismachines = $conf->config('nismachines')
+ if $conf->exists('nismachines');
+
+my @erpcdmachines = $conf->config('erpcdmachines')
+ if $conf->exists('erpcdmachines');
+
+my @radiusmachines = $conf->config('radiusmachines')
+ if $conf->exists('radiusmachines');
+
+my $textradiusprepend =
+ $conf->exists('textradiusprepend')
+ ? $conf->config('textradiusprepend')
+ : '';
-my($ferpcdmachines)="/var/spool/freeside/conf/erpcdmachines";
-my(@erpcdmachines);
-if ( -e $ferpcdmachines ) {
- open(ERPCDMACHINES,$ferpcdmachines);
- @erpcdmachines=map {
- /^(.*)$/ or die "Illegal line in conf/erpcdmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <ERPCDMACHINES>;
- close ERPCDMACHINES;
+warn "using depriciated textradiusprepend file" if $textradiusprepend;
+
+
+my $radiusprepend =
+ $conf->exists('radiusprepend')
+ ? join("\n", $conf->config('radiusprepend'))
+ : '';
+
+my @vpopmailmachines = $conf->config('vpopmailmachines')
+ if $conf->exists('vpopmailmachines');
+my $vpopmailrestart = '';
+$vpopmailrestart = $conf->config('vpopmailrestart')
+ if $conf->exists('vpopmailrestart');
+
+my ($machine, $vpopdir, $vpopuid, $vpopgid) = split (/\s+/, $vpopmailmachines[0]) if $vpopmailmachines[0];
+
+my($shellmachine, @qmailmachines);
+if ( $conf->exists('qmailmachines') ) {
+ $shellmachine = $conf->config('shellmachine');
+ @qmailmachines = $conf->config('qmailmachines');
}
-my($fradiusmachines)="/var/spool/freeside/conf/radiusmachines";
-my(@radiusmachines);
-if ( -e $fradiusmachines ) {
- open(RADIUSMACHINES,$fradiusmachines);
- @radiusmachines=map {
- /^(.*)$/ or die "Illegal line in conf/radiusmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <RADIUSMACHINES>;
- close RADIUSMACHINES;
+my(@sendmailmachines, $sendmailconfigpath, $sendmailrestart);
+if ( $conf->exists('sendmailmachines') ) {
+ @sendmailmachines = $conf->config('sendmailmachines');
+ $sendmailconfigpath = $conf->config('sendmailconfigpath') || '/etc';
+ $sendmailrestart = $conf->config('sendmailrestart');
}
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct.export.lock";
+my $mydomain = $conf->config('domain') if $conf->exists('domain');
+
+
-adminsuidsetup;
my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-srand(time|$$);
+require 5.004; #srand(time|$$);
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct.export.lock.". datasrc;
open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
select(EXPORT); $|=1; select(STDOUT);
seek(EXPORT,0,0);
my($pid)=<EXPORT>;
chop($pid);
- #no reason to start loct of blocking processes
+ #no reason to start lots of blocking processes
die "Is another export process running under pid $pid?\n";
}
seek(EXPORT,0,0);
print EXPORT $$,"\n";
-my(@svc_acct)=qsearch('svc_acct',{});
+my(@svc_domain)=qsearch('svc_domain',{});
( open(MASTER,">$spooldir/master.passwd")
- and flock(MASTER,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/master.passwd: $!";
+ and flock(MASTER,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/.master.passwd: $!";
( open(PASSWD,">$spooldir/passwd")
and flock(PASSWD,LOCK_EX|LOCK_NB)
) or die "Can't open $spooldir/passwd: $!";
( open(SHADOW,">$spooldir/shadow")
- and flock(SHADOW,LOCK_EX|LOCK_NB)
+ and flock(SHADOW,LOCK_EX|LOCK_NB)
) or die "Can't open $spooldir/shadow: $!";
-( open(ACP_PASSWD,">$spooldir/acp_passwd")
- and flock (ACP_PASSWD,LOCK_EX|LOCK_NB)
+( open(ACP_PASSWD,">$spooldir/acp_passwd")
+ and flock(ACP_PASSWD,LOCK_EX|LOCK_NB)
) or die "Can't open $spooldir/acp_passwd: $!";
-( open (ACP_DIALUP,">$spooldir/acp_dialup")
- and flock(ACP_DIALUP,LOCK_EX|LOCK_NB)
+( open(ACP_DIALUP,">$spooldir/acp_dialup")
+ and flock(ACP_DIALUP,LOCK_EX|LOCK_NB)
) or die "Can't open $spooldir/acp_dialup: $!";
-( open (USERS,">$spooldir/users")
- and flock(USERS,LOCK_EX|LOCK_NB)
+( open(USERS,">$spooldir/users")
+ and flock(USERS,LOCK_EX|LOCK_NB)
) or die "Can't open $spooldir/users: $!";
+( open(ASSIGN,">$spooldir/assign")
+ and flock(ASSIGN,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/assign: $!";
+( open(RCPTHOSTS,">$spooldir/rcpthosts")
+ and flock(RCPTHOSTS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/rcpthosts: $!";
+( open(VPOPRCPTHOSTS,">$spooldir/vpoprcpthosts")
+ and flock(VPOPRCPTHOSTS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/rcpthosts: $!";
+( open(RECIPIENTMAP,">$spooldir/recipientmap")
+ and flock(RECIPIENTMAP,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/recipientmap: $!";
+( open(VIRTUALDOMAINS,">$spooldir/virtualdomains")
+ and flock(VIRTUALDOMAINS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/virtualdomains: $!";
+( open(VPOPVIRTUALDOMAINS,">$spooldir/vpopvirtualdomains")
+ and flock(VPOPVIRTUALDOMAINS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/virtualdomains: $!";
+( open(VIRTUSERTABLE,">$spooldir/virtusertable")
+ and flock(VIRTUSERTABLE,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/virtusertable: $!";
+( open(SENDMAIL_CW,">$spooldir/sendmail.cw")
+ and flock(SENDMAIL_CW,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/sendmail.cw: $!";
+
+
+
chmod 0644, "$spooldir/passwd",
"$spooldir/acp_dialup",
+ "$spooldir/assign",
+ "$spooldir/sendmail.cw",
+ "$spooldir/virtusertable",
+ "$spooldir/rcpthosts",
+ "$spooldir/vpoprcpthosts",
+ "$spooldir/recipientmap",
+ "$spooldir/virtualdomains",
+ "$spooldir/vpopvirtualdomains",
+
;
chmod 0600, "$spooldir/master.passwd",
- "$spooldir/acp_passwd",
+ "$spooldir/acp_passwd",
"$spooldir/shadow",
"$spooldir/users",
;
-setpriority(0,0,10);
+rmtree"$spooldir/domains", 0, 1;
+mkdir "$spooldir/domains", 0700;
-my($svc_acct);
-foreach $svc_acct (@svc_acct) {
-
- my($password)=$svc_acct->getfield('_password');
- my($cpassword,$rpassword);
- if ( ( length($password) <= 8 )
- && ( $password ne '*' )
- && ( $password ne '' )
- ) {
- $cpassword=crypt($password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- $rpassword=$password;
- } else {
- $cpassword=$password;
- $rpassword='UNIX';
- }
-
- if ( $svc_acct->uid =~ /^(\d+)$/ ) {
+setpriority(0,0,10);
- die "Non-root user ". $svc_acct->username. " has 0 UID!"
- if $svc_acct->uid == 0 && $svc_acct->username ne 'root';
+print USERS "$radiusprepend\n";
+
+my %usernames; ## this hack helps keep the passwd files sane
+my @sendmail;
+
+my $svc_domain;
+foreach $svc_domain (sort {$a->domain cmp $b->domain} @svc_domain) {
+
+ my($domain)=$svc_domain->domain;
+ print RCPTHOSTS "$domain\n.$domain\n";
+ print VPOPRCPTHOSTS "$domain\n";
+ print SENDMAIL_CW "$domain\n";
+
+ ###
+ # FORMAT OF THE ASSIGN/USERS FILE HERE
+ print ASSIGN join(":",
+ "+" . $domain . "-",
+ $domain,
+ $vpopuid,
+ $vpopgid,
+ $vpopdir . "/domains/" . $domain,
+ "-",
+ "",
+ "",
+ ), "\n" if $vpopmailmachines[0];
+
+ (mkdir "$spooldir/domains/" . $domain, 0700)
+ or die "Can't create $spooldir/domains/" . $domain .": $!";
+
+ ( open(QMAILDEFAULT,">$spooldir/domains/" . $domain . "/.qmail-default")
+ and flock(QMAILDEFAULT,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $spooldir/domains/" . $domain . "/.qmail-default: $!";
+
+ ( open(VPASSWD,">$spooldir/domains/" . $domain . "/vpasswd")
+ and flock(VPASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $spooldir/domains/" . $domain . "/vpasswd: $!";
+
+ my ($svc_acct);
+
+ if ($svc_domain->getfield('catchall')) {
+ $svc_acct = qsearchs('svc_acct', {'svcnum' => $svc_domain->catchall});
+ die "Cannot find catchall account for domain $domain\n" unless $svc_acct;
+
+ my $username = $svc_acct->username;
+ push @sendmail, "\@$domain\t$username\n";
+ print VIRTUALDOMAINS "$domain:$username-$domain\n",
+ ".$domain:$username-$domain\n",
+ ;
###
- # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
- print MASTER join(":",
- $svc_acct->username, # User name
- $cpassword, # Encrypted password
- $svc_acct->uid, # User ID
- $svc_acct->gid, # Group ID
- "", # Login Class
- "0", # Password Change Time
- "0", # Password Expiration Time
- $svc_acct->finger, # Users name
- $svc_acct->dir, # Users home directory
- $svc_acct->shell, # shell
- ), "\n" ;
+ # FORMAT OF THE .QMAIL-DEFAULT FILE HERE
+ print QMAILDEFAULT "| $vpopdir/bin/vdelivermail \"\" " . $svc_acct->email . "\n"
+ if $vpopmailmachines[0];
+ }else{
###
- # FORMAT OF THE PASSWD FILE HERE
- print PASSWD join(":",
- $svc_acct->username,
- 'x', # "##". $svc_acct->$username,
- $svc_acct->uid,
- $svc_acct->gid,
- $svc_acct->finger,
- $svc_acct->dir,
- $svc_acct->shell,
- ), "\n";
+ # FORMAT OF THE .QMAIL-DEFAULT FILE HERE
+ print QMAILDEFAULT "| $vpopdir/bin/vdelivermail \"\" bounce-no-mailbox\n"
+ if $vpopmailmachines[0];
+ }
- ###
- # FORMAT OF THE SHADOW FILE HERE
- print SHADOW join(":",
- $svc_acct->username,
- $cpassword,
- '',
- '',
- '',
- '',
- '',
- '',
- '',
- ), "\n";
+ print VPOPVIRTUALDOMAINS "$domain:$domain\n";
+
+ foreach $svc_acct (qsearch('svc_acct', {'domsvc' => $svc_domain->svcnum})) {
+ my($password)=$svc_acct->getfield('_password');
+ my($cpassword,$rpassword);
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ $rpassword=$password;
+ } else {
+ $cpassword=$password;
+ $rpassword='UNIX';
+ }
- }
+ my $username;
+
+ if ($mydomain && ($mydomain eq $svc_domain->domain)) {
+ $username=$svc_acct->username;
+ } elsif ($userpolicy =~ /^prepend domsvc$/) {
+ $username=$svc_acct->domsvc . $svc_acct->username;
+ } elsif ($userpolicy =~ /^append domsvc$/) {
+ $username=$svc_acct->username . $svc_acct->domsvc;
+ } elsif ($userpolicy =~ /^append domain$/) {
+ $username=$svc_acct->username . $svc_domain->domain;
+ } elsif ($userpolicy =~ /^append domain$/) {
+ $username=$svc_acct->username . $svc_domain->domain;
+ } elsif ($userpolicy =~ /^append \@domain$/) {
+ $username=$svc_acct->username . '@'. $svc_domain->domain;
+ } else {
+ die "Unknown policy in username_policy\n";
+ }
- if ( $svc_acct->slipip ne '' ) {
+ if ($svc_acct->dir ne '/dev/null' || $svc_acct->slipip ne '') {
+ if ($usernames{$username}++) {
+ die "Duplicate username detected: $username\n";
+ }
+ }
+
+ if ( $svc_acct->uid =~ /^(\d+)$/ ) {
+
+ die "Non-root user ". $svc_acct->username. " has 0 UID!"
+ if $svc_acct->uid == 0 && $svc_acct->username ne 'root';
+
+ if ( $svc_acct->dir ne "/dev/null") {
+
+ ###
+ # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
+ print MASTER join(":",
+ $username, # User name
+ $cpassword, # Encrypted password
+ $svc_acct->uid, # User ID
+ $svc_acct->gid, # Group ID
+ "", # Login Class
+ "0", # Password Change Time
+ "0", # Password Expiration Time
+ $svc_acct->finger, # Users name
+ $svc_acct->dir, # Users home directory
+ $svc_acct->shell, # shell
+ ), "\n" ;
+
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF THE SHADOW FILE HERE
+ print SHADOW join(":",
+ $username,
+ $cpassword,
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ ), "\n";
+ }
+ }
###
- # FORMAT OF THE ACP_* FILES HERE
- print ACP_PASSWD join(":",
+ # FORMAT OF THE VPASSWD FILE HERE
+ print VPASSWD join(":",
$svc_acct->username,
$cpassword,
- "0",
- "0",
- "",
- "",
- "",
+ '1',
+ '0',
+ $svc_acct->username,
+ "$vpopdir/domains/" . $svc_domain->domain ."/" . $svc_acct->username,
+ 'NOQUOTA',
), "\n";
- my($ip)=$svc_acct->slipip;
- unless ( $ip eq '0.0.0.0' || $svc_acct->slipip eq '0e0' ) {
- print ACP_DIALUP $svc_acct->username, "\t*\t", $svc_acct->slipip, "\n";
- }
+ if ( $svc_acct->slipip ne '' ) {
+
+ ###
+ # FORMAT OF THE ACP_* FILES HERE
+ print ACP_PASSWD join(":",
+ $username,
+ $cpassword,
+ "0",
+ "0",
+ "",
+ "",
+ "",
+ ), "\n";
+
+ my($ip)=$svc_acct->slipip;
+
+ unless ( $ip eq '0.0.0.0' || $svc_acct->slipip eq '0e0' ) {
+ print ACP_DIALUP $username, "\t*\t", $svc_acct->slipip, "\n";
+ }
+
+ my %radreply = $svc_acct->radius_reply;
+ my %radcheck = $svc_acct->radius_check;
+
+ my $radcheck = join ", ", map { qq($_ = "$radcheck{$_}") } keys %radcheck;
+ $radcheck .= ", " if $radcheck;
+
+ ###
+ # FORMAT OF THE USERS FILE HERE
+ print USERS
+ $username,
+ qq(\t${textradiusprepend}),
+ $radcheck,
+# qq(Password = "$rpassword"\n\t),
+ join ",\n\t", map { qq($_ = "$radreply{$_}") } keys %radreply;
+
+ #if ( $ip && $ip ne '0e0' ) {
+ # #print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
+ # print USERS qq(,\n\tFramed-IP-Address = "$ip"\n\n);
+ #} else {
+ print USERS qq(\n\n);
+ #}
+ }
+
###
- # FORMAT OF THE USERS FILE HERE
- print USERS
- $svc_acct->username, qq(\tPassword = "$rpassword"\n\t),
-
- join ",\n\t",
- map {
- /^(radius_(.*))$/;
- my($field,$attrib)=($1,$2);
- $attrib =~ s/_/\-/g;
- "$attrib = \"". $svc_acct->getfield($field). "\"";
- } grep /^radius_/ && $svc_acct->getfield($_), fields('svc_acct')
- ;
- if ( $ip && $ip ne '0e0' ) {
- print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
- } else {
- print USERS qq(\n\n);
+ # vpopmail directory structure creation
+
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username, 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . ": $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir: $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir/cur", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir/cur: $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir/new", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir/new: $!";
+ (mkdir "$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/Maildir/tmp", 0700)
+ or die "Can't create $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . " /Maildir/tmp: $!";
+
+ ( open(DOTQMAIL,">$spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/.qmail")
+ and flock(DOTQMAIL,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $spooldir/domains/" . $svc_domain->domain . "/" . $svc_acct->username . "/.qmail: $!";
+
+ my($svc_forward);
+ foreach $svc_forward (qsearch('svc_forward', {'srcsvc' => $svc_acct->svcnum})) {
+ my($destination);
+ if ($svc_forward->dstsvc) {
+ my $dst_acct = qsearchs('svc_acct', {'svcnum' => $svc_forward->dstsvc});
+ my $dst_domain = qsearchs('svc_domain', {'svcnum' => $dst_acct->domsvc});
+ $destination = $dst_acct->username . '@' . $dst_domain->domain;
+
+ if ($dst_domain->domain eq $mydomain) {
+ print VIRTUSERTABLE $svc_acct->username . "@" . $svc_domain->domain .
+ "\t" . $dst_acct->username . "\n";
+ print RECIPIENTMAP $svc_acct->username . "@" . $svc_domain->domain .
+ ":$destination\n";
+ }
+ } else {
+ $destination = $svc_forward->dst;
+ }
+
+ ###
+ # FORMAT OF .QMAIL FILES HERE
+ print DOTQMAIL "$destination\n";
}
+ flock(DOTQMAIL,LOCK_UN);
+ close DOTQMAIL;
+
}
+ flock(VPASSWD,LOCK_UN);
+ flock(QMAILDEFAULT,LOCK_UN);
+ close VPASSWD;
+ close QMAILDEFAULT;
+
}
+###
+# FORMAT OF THE ASSIGN/USERS FILE FINAL LINE HERE
+print ASSIGN ".\n";
+
+print VIRTUSERTABLE @sendmail;
+
flock(MASTER,LOCK_UN);
flock(PASSWD,LOCK_UN);
flock(SHADOW,LOCK_UN);
flock(ACP_DIALUP,LOCK_UN);
flock(ACP_PASSWD,LOCK_UN);
flock(USERS,LOCK_UN);
+flock(ASSIGN,LOCK_UN);
+flock(SENDMAIL_CW,LOCK_UN);
+flock(VIRTUSERTABLE,LOCK_UN);
+flock(RCPTHOSTS,LOCK_UN);
+flock(VPOPRCPTHOSTS,LOCK_UN);
+flock(RECIPIENTMAP,LOCK_UN);
+flock(VPOPVIRTUALDOMAINS,LOCK_UN);
close MASTER;
close PASSWD;
close ACP_DIALUP;
close ACP_PASSWD;
close USERS;
+close ASSIGN;
+close SENDMAIL_CW;
+close VIRTUSERTABLE;
+close RCPTHOSTS;
+close VPOPRCPTHOSTS;
+close RECIPIENTMAP;
+close VPOPVIRTUALDOMAINS;
###
# export stuff
#
-my($shellmachine);
-foreach $shellmachine (@shellmachines) {
- scp("$spooldir/passwd","root\@$shellmachine:/etc/passwd.new")
- == 0 or die "scp error: $!";
- scp("$spooldir/shadow","root\@$shellmachine:/etc/shadow.new")
- == 0 or die "scp error: $!";
- ssh("root\@$shellmachine",
+my($ashellmachine);
+foreach $ashellmachine (@shellmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$ashellmachine:/etc/passwd.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/shadow","root\@$ashellmachine:/etc/shadow.new")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$ashellmachine",
"( ".
"mv /etc/passwd.new /etc/passwd; ".
"mv /etc/shadow.new /etc/shadow; ".
my($bsdshellmachine);
foreach $bsdshellmachine (@bsdshellmachines) {
- scp("$spooldir/passwd","root\@$bsdshellmachine:/etc/passwd.new")
- == 0 or die "scp error: $!";
- scp("$spooldir/master.passwd","root\@$bsdshellmachine:/etc/master.passwd.new")
- == 0 or die "scp error: $!";
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$bsdshellmachine:/etc/passwd.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/master.passwd","root\@$bsdshellmachine:/etc/master.passwd.new")
+ or die "scp error: ". $scp->{errstr};
ssh("root\@$bsdshellmachine",
"( ".
"mv /etc/passwd.new /etc/passwd; ".
- "mv /etc/master.passwd.new /etc/master.passwd; ".
+ #"mv /etc/master.passwd.new /etc/master.passwd; ".
+ "pwd_mkdb /etc/master.passwd.new; ".
" )"
)
== 0 or die "ssh error: $!";
my($nismachine);
foreach $nismachine (@nismachines) {
- scp("$spooldir/passwd","root\@$nismachine:/etc/global/passwd")
- == 0 or die "scp error: $!";
- scp("$spooldir/shadow","root\@$nismachine:/etc/global/shadow")
- == 0 or die "scp error: $!";
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$nismachine:/etc/global/passwd")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/shadow","root\@$nismachine:/etc/global/shadow")
+ or die "scp error: ". $scp->{errstr};
ssh("root\@$nismachine",
"( ".
"cd /var/yp; make; ".
my($erpcdmachine);
foreach $erpcdmachine (@erpcdmachines) {
- scp("$spooldir/acp_passwd","root\@$erpcdmachine:/usr/annex/acp_passwd")
- == 0 or die "scp error: $!";
- scp("$spooldir/acp_dialup","root\@$erpcdmachine:/usr/annex/acp_dialup")
- == 0 or die "scp error: $!";
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/acp_passwd","root\@$erpcdmachine:/usr/annex/acp_passwd")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/acp_dialup","root\@$erpcdmachine:/usr/annex/acp_dialup")
+ or die "scp error: ". $scp->{errstr};
ssh("root\@$erpcdmachine",
"( ".
"kill -USR1 \`cat /usr/annex/erpcd.pid\'".
my($radiusmachine);
foreach $radiusmachine (@radiusmachines) {
- scp("$spooldir/users","root\@$radiusmachine:/etc/raddb/users")
- == 0 or die "scp error: $!";
- ssh("root\@$erpcdmachine",
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/users","root\@$radiusmachine:/etc/raddb/users")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$radiusmachine",
"( ".
"builddbm".
" )"
== 0 or die "ssh error: $!";
}
+#my @args = ("/bin/tar", "c", "--force-local", "-C", "$spooldir", "-f", "$spooldir/vpoptarball", "domains");
+
+#system {$args[0]} @args;
+
+my($vpopmailmachine);
+foreach $vpopmailmachine (@vpopmailmachines) {
+ my ($machine, $vpopdir, $vpopuid, $vpopgid) = split (/\s+/, $vpopmailmachine);
+ my $scp = new Net::SCP;
+# $scp->scp("$spooldir/vpoptarball","root\@$machine:vpoptarball")
+# or die "scp error: ". $scp->{errstr};
+# ssh("root\@$machine",
+# "( ".
+# "rm -rf domains; ".
+# "tar xf vpoptarball; ".
+# "chown -R $vpopuid:$vpopgid domains; ".
+# "tar cf vpoptarball domains; ".
+# "cd $vpopdir; ".
+# "tar xf ~/vpoptarball; ".
+# " )"
+# )
+# == 0 or die "ssh error: $!";
+
+ chdir $spooldir;
+ my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/");
+
+ system {$args[0]} @args;
+
+ $scp->scp("$spooldir/assign","root\@$machine:/var/qmail/users/assign")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/vpopvirtualdomains","root\@$machine:/var/qmail/control/virtualdomains")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/vpoprcpthosts","root\@$machine:/var/qmail/control/rcpthosts")
+ or die "scp error: ". $scp->{errstr};
+
+ ssh("root\@$machine",
+ "( ".
+ $vpopmailrestart .
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+
+
+}
+
+my($sendmailmachine);
+foreach $sendmailmachine (@sendmailmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/sendmail.cw","root\@$sendmailmachine:$sendmailconfigpath/sendmail.cw.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/virtusertable","root\@$sendmailmachine:$sendmailconfigpath/virtusertable.new")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$sendmailmachine",
+ "( ".
+ "mv $sendmailconfigpath/sendmail.cw.new $sendmailconfigpath/sendmail.cw; ".
+ "mv $sendmailconfigpath/virtusertable.new $sendmailconfigpath/virtusertable; ".
+ $sendmailrestart.
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($qmailmachine);
+foreach $qmailmachine (@qmailmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/recipientmap","root\@$qmailmachine:/var/qmail/control/recipientmap")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/virtualdomains","root\@$qmailmachine:/var/qmail/control/virtualdomains")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/rcpthosts","root\@$qmailmachine:/var/qmail/control/rcpthosts")
+ or die "scp error: ". $scp->{errstr};
+ #ssh("root\@$qmailmachine","/etc/init.d/qmail restart")
+ # == 0 or die "ssh error: $!";
+}
+
unlink $spoollock;
flock(EXPORT,LOCK_UN);
close EXPORT;
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
-#
-# ivan@sisd.com 98-mar-9
-#
-# changed 'password' field to '_password' because PgSQL 6.3 reserves this word
-# bmccane@maxbaud.net 98-Apr-3
-#
-# generalized svcparts (still needs radius import) ivan@sisd.com 98-mar-23
-#
-# radius import, now an interactive script. still needs erpcd import?
-# ivan@sisd.com 98-jun-24
-#
-# arbitrary radius attributes ivan@sisd.com 98-aug-9
-#
-# don't import /var/spool/freeside/conf/shells! ivan@sisd.com 98-aug-13
+# $Id: svc_acct.import,v 1.17 2001-08-19 10:25:44 ivan Exp $
use strict;
use vars qw(%part_svc);
use Date::Parse;
-use FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch);
use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
-adminsuidsetup;
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shuddown /bin/halt); #others?
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix/";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
$FS::svc_acct::nossh_hack = 1;
%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
print "\n\n", &menu_svc, "\n", <<END;
Most accounts probably have entries in passwd and users (with Port-Limit
nonexistant or 1).
print "\n\n", &menu_svc, "\n", <<END;
POP mail accounts have entries in passwd only, and have a particular shell.
END
-print "Enter that shell: ";
-my($pop_shell)=&getvalue;
+my($pop_shell)=&getvalue("Enter that shell:");
my($popmail_svcpart)=&getpart;
print "\n\n", &menu_svc, "\n", <<END;
Enter the location and name of your _user_ passwd file, for example
"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
END
-print ":";
-my($loc_passwd)=&getvalue;
+my($loc_passwd)=&getvalue(":");
iscp("root\@$loc_passwd", "$spooldir/passwd.import");
print "\n\n", <<END;
Enter the location and name of your _user_ shadow file, for example
"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
END
-print ":";
-my($loc_shadow)=&getvalue;
+my($loc_shadow)=&getvalue(":");
iscp("root\@$loc_shadow", "$spooldir/shadow.import");
print "\n\n", <<END;
Enter the location and name of your radius "users" file, for example
"radius.isp.com:/etc/raddb/users"
END
-print ":";
-my($loc_users)=&getvalue;
+my($loc_users)=&getvalue(":");
iscp("root\@$loc_users", "$spooldir/users.import");
sub menu_svc {
( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
}
sub getpart {
- print "Enter part number, or 0 for none: ";
- &getvalue;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
}
print "\n\n";
my(%param,$username);
while (<USERS>) {
chop;
- next if /^$/;
+ next if /^\s*$/;
+ next if /^\s*#/;
if ( /^\S/ ) {
- /^(\w+)\s+Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/
+ /^(\w+)\s+(Auth-Type\s+=\s+Local,\s+)?Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/
or die "1Unexpected line in users.import: $_";
my($password,$expiration);
- ($username,$password,$expiration)=(lc($1),$2,$4);
+ ($username,$password,$expiration)=(lc($1),$3,$5);
+ $password = '' if $password eq 'UNIX';
$upassword{$username}=$password;
undef %param;
} else {
while (<USERS>) {
chop;
if ( /^\s*$/ ) {
- $ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
- delete $param{'radius_Framed_IP_Address'};
+ if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+ } else {
+ $ip{$username} = '0e0';
+ }
$allparam{$username}={ %param };
last;
} elsif ( /^\s+([\w\-]+)\s=\s"?([\w\.\-\s]+)"?,?\s*$/ ) {
}
}
#? incase there isn't a terminating blank line ?
-$ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
-delete $param{'radius_Framed_IP_Address'};
+if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+} else {
+ $ip{$username} = '0e0';
+}
$allparam{$username}={ %param };
my(%password);
while (<SHADOW>) {
chop;
my($username,$password)=split(/:/);
+ #$password =~ s/^\!$/\*/;
+ #$password =~ s/\!+/\*SUSPENDED\* /;
$password{$username}=$password;
}
$svcpart = $shell_svcpart;
}
- my($svc_acct) = create FS::svc_acct ({
- 'svcpart' => $svcpart,
- 'username' => $username,
- 'password' => $password,
- 'uid' => $uid,
- 'gid' => $gid,
- 'finger' => $finger,
- 'dir' => $dir,
- 'shell' => $shell,
- 'slipip' => $ip{$username},
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'uid' => $uid,
+ 'gid' => $gid,
+ 'finger' => $finger,
+ 'dir' => $dir,
+ 'shell' => $shell,
+ 'slipip' => $ip{$username},
%{$allparam{$username}},
});
my($error);
die "Illegal Port-Limit in users!\n";
}
- my($svc_acct) = create FS::svc_acct ({
- 'svcpart' => $svcpart,
- 'username' => $username,
- 'password' => $password,
- 'slipip' => $ip{$username},
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'slipip' => $ip{$username},
%{$allparam{$username}},
});
my($error);
delete $upassword{$username};
}
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.import user\n";
+}
+
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# Create and export VoiceNet_quasar.m4
-#
-# ivan@voicenet.com late oct 96
-#
-# change priority (after copies) to 19, not 10
-# ivan@voicenet.com 97-feb-5
-#
-# put file in different place and run different script, as per matt and
-# mohamed
-# ivan@voicenet.com 97-mar-10
-#
-# added exit if stuff is already locked ivan@voicenet.com 97-apr-15
-#
-# removed mail2
-# ivan@voicenet.com 97-jul-10
-#
-# rewrote lots of the bits, now exports qmail "virtualdomain",
-# "recipientmap" and "rcpthosts" files as well
-#
-# ivan@voicenet.com 97-sep-4
-#
-# adds ".extra" files
-#
-# ivan@voicenet.com 97-sep-29
-#
-# added ".pp" files, ugh.
-#
-# ivan@voicenet.com 97-oct-1
-#
-# rewrite ivan@sisd.com 98-mar-9
-#
-# now can create .qmail-default files ivan@sisd.com 98-mar-10
-#
-# put example $my_domain declaration in ivan@sisd.com 98-mar-23
-#
-# /var/spool/freeside/conf and sendmail updates ivan@sisd.com 98-aug-14
-
-use strict;
-use Fcntl qw(:flock);
-use FS::SSH qw(ssh scp);
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearch qsearchs);
-
-my($conf_shellm)="/var/spool/freeside/conf/shellmachine";
-my($fqmailmachines)="/var/spool/freeside/conf/qmailmachines";
-my($shellmachine);
-my(@qmailmachines);
-if ( -e $fqmailmachines ) {
- open(SHELLMACHINE,$conf_shellm) or die "Can't open $conf_shellm: $!";
- <SHELLMACHINE> =~ /^([\w\.\-]+)$/ or die "Illegal $conf_shellm";
- $shellmachine = $1;
- close SHELLMACHINE;
- open(QMAILMACHINES,$fqmailmachines);
- @qmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/qmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <QMAILMACHINES>;
- close QMAILMACHINES;
-}
-
-my($fsendmailmachines)="/var/spool/freeside/conf/sendmailmachines";
-my(@sendmailmachines);
-if ( -e $fsendmailmachines ) {
- open(SENDMAILMACHINES,$fsendmailmachines);
- @sendmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/sendmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SENDMAILMACHINES>;
- close SENDMAILMACHINES;
-}
-
-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($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct_sm.export.lock";
-
-adminsuidsetup;
-umask 066;
-
-open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
-select(EXPORT); $|=1; select(STDOUT);
-unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
- seek(EXPORT,0,0);
- my($pid)=<EXPORT>;
- chop($pid);
- #no reason to start locks of blocking processes
- die "Is another export process running under pid $pid?\n";
-}
-seek(EXPORT,0,0);
-print EXPORT $$,"\n";
-
-my(@svc_acct_sm)=qsearch('svc_acct_sm',{});
-
-( open(RCPTHOSTS,">$spooldir/rcpthosts")
- and flock(RCPTHOSTS,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/rcpthosts: $!";
-( open(RECIPIENTMAP,">$spooldir/recipientmap")
- and flock(RECIPIENTMAP,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/recipientmap: $!";
-( open(VIRTUALDOMAINS,">$spooldir/virtualdomains")
- and flock(VIRTUALDOMAINS,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/virtualdomains: $!";
-( open(VIRTUSERTABLE,">$spooldir/virtusertable")
- and flock(VIRTUSERTABLE,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/virtusertable: $!";
-( open(SENDMAIL_CW,">$spooldir/sendmail.cw")
- and flock(SENDMAIL_CW,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/sendmail.cw: $!";
-
-setpriority(0,0,10);
-
-my($svc_domain,%domain);
-foreach $svc_domain ( qsearch('svc_domain',{}) ) {
- my($domain)=$svc_domain->domain;
- $domain{$svc_domain->svcnum}=$domain;
- print RCPTHOSTS "$domain\n.$domain\n";
- print SENDMAIL_CW "$domain\n";
-}
-
-my(@sendmail);
-
-my($svc_acct_sm);
-foreach $svc_acct_sm ( qsearch('svc_acct_sm') ) {
- my($domsvc,$domuid,$domuser)=(
- $svc_acct_sm->domsvc,
- $svc_acct_sm->domuid,
- $svc_acct_sm->domuser,
- );
- my($domain)=$domain{$domsvc};
- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
- my($username,$dir,$uid,$gid)=(
- $svc_acct->username,
- $svc_acct->dir,
- $svc_acct->uid,
- $svc_acct->gid,
- );
- next unless $username && $domain && $domuser;
-
- if ($domuser eq '*') {
- push @sendmail, "\@$domain\t$username\n";
- print VIRTUALDOMAINS "$domain:$username-$domain\n",
- ".$domain:$username-$domain\n",
- ;
- ###
- # qmail
- ssh("root\@$shellmachine",
- "[ -e $dir/.qmail-default ] || { touch $dir/.qmail-default; chown $uid:$gid $dir/.qmail-default; }"
- ) if ( $shellmachine && $dir && $uid );
-
- } else {
- print VIRTUSERTABLE "$domuser\@$domain\t$username\n";
- print RECIPIENTMAP "$domuser\@$domain:$username\@$mydomain\n";
- }
-
- print VIRTUSERTABLE @sendmail;
-
-}
-
-chmod 0644, "$spooldir/sendmail.cw",
- "$spooldir/virtusertable",
- "$spooldir/rcpthosts",
- "$spooldir/recipientmap",
- "$spooldir/virtualdomains",
-;
-
-flock(SENDMAIL_CW,LOCK_UN);
-flock(VIRTUSERTABLE,LOCK_UN);
-flock(RCPTHOSTS,LOCK_UN);
-flock(RECIPIENTMAP,LOCK_UN);
-flock(VIRTUALDOMAINS,LOCK_UN);
-
-close SENDMAIL_CW;
-close VIRTUSERTABLE;
-close RCPTHOSTS;
-close RECIPIENTMAP;
-close VIRTUALDOMAINS;
-
-###
-# export stuff
-#
-
-my($sendmailmachine);
-foreach $sendmailmachine (@sendmailmachines) {
- scp("$spooldir/sendmail.cw","root\@$sendmailmachine:/etc/sendmail.cw.new")
- == 0 or die "scp error: $!";
- scp("$spooldir/virtusertable","root\@$sendmailmachine:/etc/virtusertable.new")
- == 0 or die "scp error: $!";
- ssh("root\@$sendmailmachine",
- "( ".
- "mv /etc/sendmail.cw.new /etc/sendmail.cw; ".
- "mv /etc/virtusertable.new /etc/virtusertable; ".
- #"/etc/init.d/sendmail restart; ".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-my($qmailmachine);
-foreach $qmailmachine (@qmailmachines) {
- scp("$spooldir/recipientmap","root\@$qmailmachine:/var/qmail/control/recipientmap")
- == 0 or die "scp error: $!";
- scp("$spooldir/virtualdomains","root\@$qmailmachine:/var/qmail/control/virtualdomains")
- == 0 or die "scp error: $!";
- scp("$spooldir/rcpthosts","root\@$qmailmachine:/var/qmail/control/rcpthosts")
- == 0 or die "scp error: $!";
- #ssh("root\@$qmailmachine","/etc/init.d/qmail restart")
- # == 0 or die "ssh error: $!";
-}
-
-unlink $spoollock;
-flock(EXPORT,LOCK_UN);
-close EXPORT;
-
#!/usr/bin/perl -Tw
#
-# ivan@sisd.com 98-mar-9
-#
-# generalized svcparts ivan@sisd.com 98-mar-23
-
-# You really need to enable ssh into a shell machine as this needs to rename
-# .qmail-extension files.
-#
-# now an interactive script ivan@sisd.com 98-jun-30
-#
-# has an (untested) section for sendmail, s/warn/die/g and generates a program
-# to run on your mail machine _later_ instead of ssh'ing for each user
-# ivan@sisd.com 98-jul-13
+# $Id: svc_acct_sm.import,v 1.10 2001-08-21 02:43:18 ivan Exp $
use strict;
use vars qw(%d_part_svc %m_part_svc);
-use FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch qsearchs);
use FS::svc_acct_sm;
use FS::svc_domain;
+use FS::svc_acct;
+use FS::part_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
my(%mta) = (
1 => "qmail",
%m_part_svc =
map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'});
+die "No services with svcdb svc_domain!\n" unless %d_part_svc;
+die "No services with svcdb svc_svc_acct_sm!\n" unless %m_part_svc;
+
print "\n\n",
( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
- "\n\nEnter part number for domains: ";
-my($domain_svcpart)=&getvalue;
+ "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $domain_svcpart =
+ query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
+$^W=1;
print "\n\n",
( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ),
- "\n\nEnter part number for mail aliases: ";
-my($mailalias_svcpart)=&getvalue;
+ "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $mailalias_svcpart =
+ query "Enter part number for mail aliases: ", 'irk', [ keys %m_part_svc ];
+$^W=1;
print "\n\n", <<END;
Select your MTA from the following list.
END
print join "\n", map "$_: $mta{$_}", sort keys %mta;
-print "\n\n:";
-my($mta)=&getvalue;
+print "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $mta = query ":", 'irk', [ keys %mta ];
+$^W=1;
if ( $mta{$mta} eq "qmail" ) {
Enter the location and name of your qmail control directory, for example
"mail.isp.com:/var/qmail/control"
END
- print ":";
- my($control)=&getvalue;
+ my($control)=&getvalue(":");
iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import");
# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import");
iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import");
Enter the location and name of your sendmail virtual user table, for example
"mail.isp.com:/etc/virtusertable"
END
- print ":";
- my($virtusertable)=&getvalue;
+ my($virtusertable)=&getvalue(":");
iscp("root\@$virtusertable","$spooldir/virtusertable.import");
print "\n\n", <<END;
Enter the location and name of your sendmail.cw file, for example
"mail.isp.com:/etc/sendmail.cw"
END
- print ":";
- my($sendmail_cw)=&getvalue;
+ my($sendmail_cw)=&getvalue(":");
iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import");
} else {
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; #Term::Query isn't -w-safe
+ my $data = query $prompt, '';
+ $^W=1;
+ $data;
}
print "\n\n";
while (<RCPTHOSTS>) {
next if /^(#|$)/;
+ next if $mta{$mta} eq 'sendmail' && /^\s*$/; #blank lines
/^\.?([\w\-\.]+)$/
#or do { warn "Strange rcpthosts/sendmail.cw line: $_"; next; };
or die "Strange rcpthosts/sendmail.cw line: $_";
my $domain = $1;
my($svc_domain);
unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) {
- $svc_domain = create FS::svc_domain ({
+ $svc_domain = new FS::svc_domain ({
'domain' => $domain,
'svcpart' => $domain_svcpart,
'action' => 'N',
}
unless ( exists $svcnum{$domain} ) {
- my($svc_domain) = create FS::svc_domain ({
+ my($svc_domain) = new FS::svc_domain ({
'domain' => $domain,
'svcpart' => $domain_svcpart,
'action' => 'N',
$svcnum{$domain}=$svc_domain->svcnum;
}
- my($svc_acct_sm)=create FS::svc_acct_sm ({
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
'domsvc' => $svcnum{$domain},
'domuid' => $svc_acct->uid,
'domuser' => '*',
or die "Can't open $spooldir/virtusertable.import: $!";
while (<VIRTUSERTABLE>) {
next if /^#/; #comments?
- /^([\w\-\.]+)?\@([\w\-\.]+)\t([\w\-\.]+)$/
+ next if /^\s*$/; #blank lines
+ /^([\w\-\.]+)?\@([\w\-\.]+)\t+([\w\-\.]+)$/
#or do { warn "Strange virtusertable line: $_"; next; };
or die "Strange virtusertable line: $_";
my($domuser,$domain,$username)=($1,$2,$3);
die "Unknown user $username in virtusertable";
next;
}
- my($svc_acct_sm)=create FS::svc_acct_sm ({
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
'domsvc' => $svcnum{$domain},
'domuid' => $svc_acct->uid,
'domuser' => $domuser || '*',
$spooldir/virtualdomains !
END
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct_sm.import user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: svc_domain.erase,v 1.1 2002-04-20 11:57:35 ivan Exp $
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+
+use FS::domain_record;
+use FS::svc_domain;
+
+adminsuidsetup(shift @ARGV) or die "Usage: svc_domain.erase user\n";
+
+foreach my $record ( qsearch('domain_record',{}), qsearch('svc_domain', {} ) ) {
+ my $error = $record->delete;
+ die $error if $error;
+}
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: svc_domain.import,v 1.6 2002-05-20 11:02:47 ivan Exp $
+
+#need to manually put header in /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER
+
+use strict;
+use vars qw( %d_part_svc );
+use Term::Query qw(query);
+#use BIND::Conf_Parser;
+#use DNS::ZoneParse;
+
+#use Net::SCP qw(iscp);
+use Net::SCP qw(scp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); #qsearchs);
+#use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::domain_record;
+#use FS::svc_acct;
+#use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir unless -d $spooldir;
+
+%d_part_svc =
+ map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+
+print "\n\n",
+ ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
+ "\n\n";
+use vars qw($domain_svcpart);
+$^W=0; #Term::Query isn't -w-safe
+$domain_svcpart =
+ query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
+$^W=1;
+
+print "\n\n", <<END;
+Enter the location and name of your primary named.conf file, for example
+"ns.isp.com:/var/named/named.conf"
+END
+my($named_conf)=&getvalue(":");
+
+use vars qw($named_machine $prefix);
+$named_machine = (split(/:/, $named_conf))[0];
+$prefix = "$spooldir/$named_machine";
+mkdir $prefix unless -d $prefix;
+
+#iscp("root\@$named_conf","$prefix/named.conf.import");
+scp("root\@$named_conf","$prefix/named.conf.import");
+
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+##
+
+$FS::svc_domain::whois_hack=1;
+
+my $p = Parser->new;
+$p->parse_file("$prefix/named.conf.import");
+
+print "\nBIND import completed.\n";
+
+##
+
+sub usage {
+ die "Usage:\n\n svc_domain.import user\n";
+}
+
+########
+BEGIN {
+
+ package Parser;
+ use BIND::Conf_Parser;
+ use vars qw(@ISA $named_dir);
+ @ISA = qw(BIND::Conf_Parser);
+
+ sub handle_option {
+ my($self, $option, $argument) = @_;
+ return unless $option eq "directory";
+ $named_dir = $argument;
+ }
+
+ sub handle_zone {
+ my($self, $name, $class, $type, $options) = @_;
+ return unless $class eq 'in';
+ return if grep { $name eq $_ }
+ ( qw( . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa ) );
+
+ my $domain = new FS::svc_domain( {
+ svcpart => $main::domain_svcpart,
+ domain => $name,
+ action => 'N',
+ } );
+ my $error = $domain->insert;
+ die $error if $error;
+
+ if ( $type eq 'slave' ) {
+
+ #use Data::Dumper;
+ #print Dumper($options);
+ #exit;
+
+ foreach my $master ( @{ $options->{masters} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => '_mstr',
+ 'recdata' => $master,
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+
+ } elsif ( $type eq 'master' ) {
+
+ my $file = $options->{file};
+
+ use File::Basename;
+ my $basefile = basename($file);
+ my $sourcefile = $file;
+ $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//;
+ use Net::SCP qw(iscp scp);
+ scp("root\@$main::named_machine:$sourcefile",
+ "$main::prefix/$basefile.import");
+
+ use DNS::ZoneParse;
+ my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import");
+
+ my $dump = $zone->Dump;
+
+ #use Data::Dumper;
+ #print "$name: ". Dumper($dump);
+ #exit;
+
+ foreach my $rectype ( keys %$dump ) {
+ if ( $rectype =~ /^SOA$/i ) {
+ my $rec = $dump->{$rectype};
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{origin},
+ 'recaf' => 'IN',
+ 'rectype' => $rectype,
+ 'recdata' =>
+ $rec->{primary}. ' '. $rec->{email}. ' ( '.
+ join(' ', map $rec->{$_},
+ qw( serial refresh retry expire minimumTTL ) ).
+ ' )',
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ } else {
+ #die $dump->{$rectype};
+ foreach my $rec ( @{ $dump->{$rectype} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{name},
+ 'recaf' => $rec->{class},
+ 'rectype' => $rectype,
+ 'recdata' => ( $rectype =~ /^MX$/i
+ ? $rec->{priority}. ' '. $rec->{host}
+ : $rec->{host} ),
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+ }
+ }
+
+ }
+
+ }
+
+}
+#########
+
+++ /dev/null
-Silicon Interactive Software Design
-119 Signal Hill Road
-Holland, PA 18966-2924
-
--- /dev/null
+
+
+Ivan Kohler
+1339 Hayes St.
+San Francisco, CA 94117
+
+
+{ $first; } { $last; }:
+
+ We thank you for your continuing patronage. This notice is to remind you
+that your { $payby } used to pay SISD.COM for Internet
+service will expire on { use Date::Format; time2str("%x", $expdate); }. Please provide us with new billing
+information so that we may continue your service uninterrupted.
+
+Very Truly Yours,
+
+ SISD Service Team
+
+
+
--- /dev/null
+Hi,
+
+Your credit card could not be processed for the following reason:
+ { $error }
+
+Please provide us with new billing infromation so that we may continue your
+service uninterrupted.
+
+Thanks.
+
+++ /dev/null
-domain.tld
--- /dev/null
+ivan-unconfigured-freeside-installation@420.am
--- /dev/null
+
+ Invoice
+ { substr("Page $page of $total_pages ", 0, 19); } { use Date::Format; time2str("%x", $date); } FS-{ $invnum; }
+
+
+Ivan Kohler
+1339 Hayes St.
+San Francisco, CA 94117
+
+
+{ $address[0]; }
+{ $address[1]; }
+{ $address[2]; }
+{ $address[3]; }
+{ $address[4]; }
+{ $address[5]; }
+
+{
+ join("\n",
+ map {
+ my ( $desc, $price ) = @{$_};
+ " ". substr( $desc. " "x65, 0, 65). " ". substr( $price. " "x11, 0, 11);
+ } invoice_lines(31)
+ );
+}
+
+ -=> Freeside - open-source billing for ISPs - http://www.sisd.com/freeside <=-
+++ /dev/null
-domreg@domain.tld
+++ /dev/null
-192.168.1.1 ns1.domain.tld
-192.168.1.2 ns2.domain.tld
-192.168.1.3 ns3.domain.tld
+++ /dev/null
-[ URL ftp://rs.internic.net/templates/domain-template.txt ] [ 03/98 ]
-
-******* Please DO NOT REMOVE Version Number or Sections A-Q ********
-
-Domain Version Number: 4.0
-
-******* Email completed agreement to hostmaster@internic.net *******
-
- NETWORK SOLUTIONS, INC.
-
- DOMAIN NAME REGISTRATION AGREEMENT
-
-
-A. Introduction. This domain name registration agreement
-("Registration Agreement") is submitted to NETWORK SOLUTIONS, INC.
-("NSI") for the purpose of applying for and registering a domain name
-on the Internet. If this Registration Agreement is accepted by NSI,
-and a domain name is registered in NSI's domain name database and
-assigned to the Registrant, Registrant ("Registrant") agrees to be
-bound by the terms of this Registration Agreement and the terms of
-NSI's Domain Name Dispute Policy ("Dispute Policy") which is
-incorporated herein by reference and made a part of this Registration
-Agreement. This Registration Agreement shall be accepted at the
-offices of NSI.
-
-B. Fees and Payments.
-
-1) Registration or renewal (re-registration) date through March 31, 1998:
-Registrant agrees to pay a registration fee of One Hundred United States
-Dollars (US$100) as consideration for the registration of each new domain
-name or Fifty United States Dollars (US$50) to renew (re-register) an
-existing registration.
-2) Registration or renewal date on and after April 1, 1998: Registrant
-agrees to pay a registration fee of Seventy United States Dollars (US$70)
-as consideration for the registration of each new domain name or the
-applicable renewal (re-registration) fee (currently Thirty-Five United
-States Dollars (US$35)) at the time of renewal (re-registration).
-3) Period of Service: The non-refundable fee covers a period of two (2)
-years for each new registration, and one (1) year for each renewal,
-and includes any permitted modification(s) to the domain name record
-during the covered period.
-4) Payment: Payment is due to Network Solutions within thirty (30)
-days from the date of the invoice.
-
-C. Dispute Policy. Registrant agrees, as a condition to
-submitting this Registration Agreement, and if the Registration
-Agreement is accepted by NSI, that the Registrant shall be bound by
-NSI's current Dispute Policy. The current version of the Dispute
-Policy may be found at the InterNIC Registration Services web site:
-"http://www.netsol.com/rs/dispute-policy.html".
-
-D. Dispute Policy Changes or Modifications. Registrant agrees
-that NSI, in its sole discretion, may change or modify the Dispute
-Policy, incorporated by reference herein, at any time. Registrant
-agrees that Registrant's maintaining the registration of a domain name
-after changes or modifications to the Dispute Policy become effective
-constitutes Registrant's continued acceptance of these changes or
-modifications. Registrant agrees that if Registrant considers any such
-changes or modifications to be unacceptable, Registrant may request
-that the domain name be deleted from the domain name database.
-
-E. Disputes. Registrant agrees that, if the registration of its
-domain name is challenged by any third party, the Registrant will be
-subject to the provisions specified in the Dispute Policy.
-
-F. Agents. Registrant agrees that if this Registration Agreement
-is completed by an agent for the Registrant, such as an ISP or
-Administrative Contact/Agent, the Registrant is nonetheless bound as a
-principal by all terms and conditions herein, including the Dispute
-Policy.
-
-G. Limitation of Liability. Registrant agrees that NSI shall have
-no liability to the Registrant for any loss Registrant may incur in
-connection with NSI's processing of this Registration Agreement, in
-connection with NSI's processing of any authorized modification to the
-domain name's record during the covered period, as a result of the
-Registrant's ISP's failure to pay either the initial registration fee
-or renewal fee, or as a result of the application of the provisions of
-the Dispute Policy. Registrant agrees that in no event shall the
-maximum liability of NSI under this Agreement for any matter exceed
-Five Hundred United States Dollars (US$500).
-
-H. Indemnity. Registrant agrees, in the event the Registration
-Agreement is accepted by NSI and a subsequent dispute arises with any
-third party, to indemnify and hold NSI harmless pursuant to the terms
-and conditions contained in the Dispute Policy.
-
-I. Breach. Registrant agrees that failure to abide by any
-provision of this Registration Agreement or the Dispute Policy may be
-considered by NSI to be a material breach and that NSI may provide a
-written notice, describing the breach, to the Registrant. If, within
-thirty (30) days of the date of mailing such notice, the Registrant
-fails to provide evidence, which is reasonably satisfactory to NSI,
-that it has not breached its obligations, then NSI may delete
-Registrant's registration of the domain name. Any such breach by a
-Registrant shall not be deemed to be excused simply because NSI did
-not act earlier in response to that, or any other, breach by the
-Registrant.
-
-J. No Guaranty. Registrant agrees that, by registration of a
-domain name, such registration does not confer immunity from objection
-to either the registration or use of the domain name.
-
-K. Warranty. Registrant warrants by submitting this Registration
-Agreement that, to the best of Registrant's knowledge and belief, the
-information submitted herein is true and correct, and that any future
-changes to this information will be provided to NSI in a timely manner
-according to the domain name modification procedures in place at that
-time. Breach of this warranty will constitute a material breach.
-
-L. Revocation. Registrant agrees that NSI may delete a
-Registrant's domain name if this Registration Agreement, or subsequent
-modification(s) thereto, contains false or misleading information, or
-conceals or omits any information NSI would likely consider material
-to its decision to approve this Registration Agreement.
-
-M. Right of Refusal. NSI, in its sole discretion, reserves the
-right to refuse to approve the Registration Agreement for any
-Registrant. Registrant agrees that the submission of this Registration
-Agreement does not obligate NSI to accept this Registration Agreement.
-Registrant agrees that NSI shall not be liable for loss or damages
-that may result from NSI's refusal to accept this Registration
-Agreement.
-
-N. Severability. Registrant agrees that the terms of this
-Registration Agreement are severable. If any term or provision is
-declared invalid, it shall not affect the remaining terms or
-provisions which shall continue to be binding.
-
-O. Entirety. Registrant agrees that this Registration Agreement
-and the Dispute Policy is the complete and exclusive agreement between
-Registrant and NSI regarding the registration of Registrant's domain
-name. This Registration Agreement and the Dispute Policy supersede all
-prior agreements and understandings, whether established by custom,
-practice, policy, or precedent.
-
-P. Governing Law. Registrant agrees that this Registration
-Agreement shall be governed in all respects by and construed in
-accordance with the laws of the Commonwealth of Virginia, United
-States of America. By submitting this Registration Agreement,
-Registrant consents to the exclusive jurisdiction and venue of the
-United States District Court for the Eastern District of Virginia,
-Alexandria Division. If there is no jurisdiction in the United States
-District Court for the Eastern District of Virginia, Alexandria
-Division, then jurisdiction shall be in the Circuit Court of Fairfax
-County, Fairfax, Virginia.
-
-Q. This is Domain Name Registration Agreement Version
-Number 4.0. This Registration Agreement is only for registrations
-under top-level domains: COM, ORG, NET, and EDU. By completing
-and submitting this Registration Agreement for consideration and
-acceptance by NSI, the Registrant agrees that he/she has read and
-agrees to be bound by A through P above.
-
-
-Authorization
-0a. (N)ew (M)odify (D)elete....:###action###
-0b. Auth Scheme................:
-0c. Auth Info..................:
-
-1. Comments...................:###purpose###
-
-2. Complete Domain Name.......:###domain###
-
-Organization Using Domain Name
-
-3a. Organization Name..........:###company###
-###LOOP###
-3b. Street Address.............:###address###
-###ENDLOOP###
-3c. City.......................:###city###
-3d. State......................:###state###
-3e. Postal Code................:###zip###
-3f. Country....................:###country###
-
-Administrative Contact
-4a. NIC Handle (if known)......:
-4b. (I)ndividual (R)ole........:I
-4c. Name (Last, First).........:###last###, ###first###
-4d. Organization Name..........:###company###
-###LOOP###
-4e. Street Address.............:###address###
-###ENDLOOP###
-4f. City.......................:###city###
-4g. State......................:###state###
-4h. Postal Code................:###zip###
-4i. Country....................:###country###
-4j. Phone Number...............:###daytime###
-4k. Fax Number.................:###fax###
-4l. E-Mailbox..................:###email###
-
-Technical Contact
-5a. NIC Handle (if known)......:###tech_contact###
-5b. (I)ndividual (R)ole........:
-5c. Name (Last, First).........:
-5d. Organization Name..........:
-5e. Street Address.............:
-5f. City.......................:
-5g. State......................:
-5h. Postal Code................:
-5i. Country....................:
-5j. Phone Number...............:
-5k. Fax Number.................:
-5l. E-Mailbox..................:
-
-Billing Contact
-6a. NIC Handle (if known)......:
-6b. (I)ndividual (R)ole........:
-6c. Name (Last, First).........:
-6d. Organization Name..........:
-6e. Street Address.............:
-6f. City.......................:
-6g. State......................:
-6h. Postal Code................:
-6i. Country....................:
-6j. Phone Number...............:
-6k. Fax Number.................:
-6l. E-Mailbox..................:
-
-Prime Name Server
-7a. Primary Server Hostname....:###primary###
-7b. Primary Server Netaddress..:###primary_ip###
-
-Secondary Name Server(s)
-###LOOP###
-8a. Secondary Server Hostname..:###secondary###
-8b. Secondary Server Netaddress:###secondary_ip###
-###ENDLOOP###
-
-END OF AGREEMENT
-
+++ /dev/null
-hostmaster@internic.net
--- /dev/null
+{ sprintf("%-19s", "Page $page of $total_pages"); } {
+ my $spacer = (40 - length($title) > 0) ? 40 - length($title) : 0;
+ $spacer = int($spacer / 2);
+ my $titlelen = 40 - $spacer;
+ sprintf("%*s%-*s", $spacer, " ", $titlelen, $title);
+ } { use Date::Format; time2str("%x %X", $date); }
+
+
+{
+ join("\n", map { $_ } report_lines(57));
+}
+
+
+
+++ /dev/null
-DBI:mysql:freeside
-freeside
-put_your_password_here
-/bin/csh
+
/bin/sh
+/bin/csh
+/bin/bash
+/bin/false
--- /dev/null
+freeside for Debian
+-------------------
+
+<possible notes regarding this package - if none, delete this file>
+
+ -- Ivan Kohler <ivan-debian@420.am>, Thu, 12 Apr 2001 15:49:17 -0700
--- /dev/null
+freeside (1.3.1-1) unstable; urgency=low
+
+ * Initial Release.
+
+ -- Ivan Kohler <ivan-debian@420.am> Thu, 12 Apr 2001 15:49:17 -0700
+
+Local variables:
+mode: debian-changelog
+End:
--- /dev/null
+#
+# If you want to use this conffile, remove all comments and put files that
+# you want dpkg to process here using their absolute pathnames.
+# See section 9.1 of the packaging manual.
+#
+# for example:
+# /etc/freeside/freeside.conf
--- /dev/null
+Source: freeside
+Section: admin
+Priority: optional
+Maintainer: Ivan Kohler <ivan-debian@420.am>
+Build-Depends: debhelper (>> 3.0.0)
+Standards-Version: 3.5.2
+
+Package: freeside
+Architecture: any
+Depends: freeside-lib
+Recommends: freeside-doc, freeside-ui-webui, libterm-query-perl
+Suggests: freeside-passwd-server, freeside-signup-server, freeside-session-server
+Description: Billing and administration package for ISPs.
+ Freeside is a billing and account administration package for ISPs. It stores
+ customer information in an SQL database, and will update UNIX passwd and
+ shadow files, and configuration for sendmail, qmail, BIND and/or Apache.
+ It is also useful as a central database of accounts/domains/web-space
+ for a large number of machines.
+
+Package: freeside-doc
+Architecture: all
+Description: Documentation for freeside
+ This package provides the HTML documentation for Freeside, a billing and
+ account administration package for ISPs.
+
+Package: freeside-lib
+Architecture: all
+Depends: libdigest-md5-perl, liburi-perl, libhtml-parser-perl, libnet-perl, liblocale-codes-perl, libnet-whois-perl, libwww-perl, libbusiness-creditcard-perl, mailtools, libtimedate-perl, libdate-manip-perl, libfile-counterfile-perl, libfreezethaw-perl, libtext-template-perl, libdbd-pg-perl
+Description: Freeside libraries and extension API
+ This package contains the libraries which implement the business logic and
+ backend functions of Freeside, a billing and account administration package
+ for ISPs. This package also contains the manual pages for the library API.
+
+Package: freeside-ui-web
+Architecture: all
+Depends: libstring-approx-perl, freeside-lib, libapache-mod-perl|apache-perl
+Suggests: libapache-mod-ssl|apache-ssl
+Description: Easy-to-use web interface for Freeside
+ This package contains the web interface for Freeside, a billing and account
+ administration package for ISPs. This is what sales or support folks will
+ typically use to add new accounts, edit exiting accounts and so on.
+
+Package: freeside-passwd-server
+Architecture: all
+Depends: freeside-lib
+Description: Freeside password server
+ This component of Freeside, a billing and account administration package for
+ ISPs,
+
+Package: freeside-passwd-client
+Architecture: all
+Depends:
+Description:
+ <rar>
+
+Package: freeside-signup-server
+Architecture: all
+Depends: freeside-lib
+Description:
+ <rar>
+
+Package: freeside-signup-client
+Architecture: all
+Depends:
+Description:
+ <rar>
+
+Package: freeside-signup-client-webui
+Architecture: all
+Depends: freeside-signup-client-lib, httpd
+Description:
+ <rar>
+
+Package: freeside-session-server
+Architecture: all
+Depends: freeside-lib
+Description:
+ <rar>
+
+Package: freeside-session-client
+Architecture: all
+Depends: ssh
--- /dev/null
+This package was debianized by Ivan Kohler <ivan-debian@420.am> on
+Thu, 12 Apr 2001 15:49:17 -0700.
+
+It was downloaded from <fill in ftp site>
+
+Upstream Author(s): <put author(s) name and email here>
+
+Copyright:
+
+<Must follow here>
--- /dev/null
+#
+# Regular cron jobs for the freeside package
+#
+0 4 * * * root freeside_maintenance
--- /dev/null
+usr/bin
+usr/sbin
--- /dev/null
+INSTALL
+README
+TODO
--- /dev/null
+Document: freeside
+Title: Debian freeside Manual
+Author: <insert document author here>
+Abstract: This manual describes what freeside is
+ and how it can be used to
+ manage online manuals on Debian systems.
+Section: unknown
+
+Format: debiandoc-sgml
+Files: /usr/share/doc/freeside/freeside.sgml.gz
+
+Format: postscript
+Files: /usr/share/doc/freeside/freeside.ps.gz
+
+Format: text
+Files: /usr/share/doc/freeside/freeside.text.gz
+
+Format: HTML
+Index: /usr/share/doc/freeside/html/index.html
+Files: /usr/share/doc/freeside/html/*.html
+
+
--- /dev/null
+#! /bin/sh
+#
+# skeleton example file to build /etc/init.d/ scripts.
+# This file should be used to construct scripts for /etc/init.d.
+#
+# Written by Miquel van Smoorenburg <miquels@cistron.nl>.
+# Modified for Debian GNU/Linux
+# by Ian Murdock <imurdock@gnu.ai.mit.edu>.
+#
+# Version: @(#)skeleton 1.8 03-Mar-1998 miquels@cistron.nl
+#
+# This file was automatically customized by dh-make on Thu, 12 Apr 2001 15:49:17 -0700
+
+PATH=/sbin:/bin:/usr/sbin:/usr/bin
+DAEMON=/usr/sbin/freeside
+NAME=freeside
+DESC=freeside
+
+test -f $DAEMON || exit 0
+
+set -e
+
+case "$1" in
+ start)
+ echo -n "Starting $DESC: "
+ start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid \
+ --exec $DAEMON
+ echo "$NAME."
+ ;;
+ stop)
+ echo -n "Stopping $DESC: "
+ start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \
+ --exec $DAEMON
+ echo "$NAME."
+ ;;
+ #reload)
+ #
+ # If the daemon can reload its config files on the fly
+ # for example by sending it SIGHUP, do it here.
+ #
+ # If the daemon responds to changes in its config file
+ # directly anyway, make this a do-nothing entry.
+ #
+ # echo "Reloading $DESC configuration files."
+ # start-stop-daemon --stop --signal 1 --quiet --pidfile \
+ # /var/run/$NAME.pid --exec $DAEMON
+ #;;
+ restart|force-reload)
+ #
+ # If the "reload" option is implemented, move the "force-reload"
+ # option to the "reload" entry above. If not, "force-reload" is
+ # just the same as "restart".
+ #
+ echo -n "Restarting $DESC: "
+ start-stop-daemon --stop --quiet --pidfile \
+ /var/run/$NAME.pid --exec $DAEMON
+ sleep 1
+ start-stop-daemon --start --quiet --pidfile \
+ /var/run/$NAME.pid --exec $DAEMON
+ echo "$NAME."
+ ;;
+ *)
+ N=/etc/init.d/$NAME
+ # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2
+ echo "Usage: $N {start|stop|restart|force-reload}" >&2
+ exit 1
+ ;;
+esac
+
+exit 0
--- /dev/null
+.\" Hey, EMACS: -*- nroff -*-
+.\" First parameter, NAME, should be all caps
+.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection
+.\" other parameters are allowed: see man(7), man(1)
+.TH FREESIDE SECTION "April 12, 2001"
+.\" Please adjust this date whenever revising the manpage.
+.\"
+.\" Some roff macros, for reference:
+.\" .nh disable hyphenation
+.\" .hy enable hyphenation
+.\" .ad l left justify
+.\" .ad b justify to both left and right margins
+.\" .nf disable filling
+.\" .fi enable filling
+.\" .br insert line break
+.\" .sp <n> insert n+1 empty lines
+.\" for manpage-specific macros, see man(7)
+.SH NAME
+freeside \- program to do something
+.SH SYNOPSIS
+.B freeside
+.RI [ options ] " files" ...
+.br
+.B bar
+.RI [ options ] " files" ...
+.SH DESCRIPTION
+This manual page documents briefly the
+.B freeside
+and
+.B bar
+commands.
+This manual page was written for the Debian GNU/Linux distribution
+because the original program does not have a manual page.
+Instead, it has documentation in the GNU Info format; see below.
+.PP
+.\" TeX users may be more comfortable with the \fB<whatever>\fP and
+.\" \fI<whatever>\fP escape sequences to invode bold face and italics,
+.\" respectively.
+\fBfreeside\fP is a program that...
+.SH OPTIONS
+These programs follow the usual GNU command line syntax, with long
+options starting with two dashes (`-').
+A summary of options is included below.
+For a complete description, see the Info files.
+.TP
+.B \-h, \-\-help
+Show summary of options.
+.TP
+.B \-v, \-\-version
+Show version of program.
+.SH SEE ALSO
+.BR bar (1),
+.BR baz (1).
+.br
+The programs are documented fully by
+.IR "The Rise and Fall of a Fooish Bar" ,
+available via the Info system.
+.SH AUTHOR
+This manual page was written by Ivan Kohler <ivan-debian@420.am>,
+for the Debian GNU/Linux system (but may be used by others).
--- /dev/null
+<!doctype refentry PUBLIC "-//OASIS//DTD DocBook V4.1//EN" [
+
+<!-- Process this file with docbook-to-man to generate an nroff manual
+ page: `docbook-to-man manpage.sgml > manpage.1'. You may view
+ the manual page with: `docbook-to-man manpage.sgml | nroff -man |
+ less'. A typical entry in a Makefile or Makefile.am is:
+
+manpage.1: manpage.sgml
+ docbook-to-man $< > $@
+ -->
+
+ <!-- Fill in your name for FIRSTNAME and SURNAME. -->
+ <!ENTITY dhfirstname "<firstname>FIRSTNAME</firstname>">
+ <!ENTITY dhsurname "<surname>SURNAME</surname>">
+ <!-- Please adjust the date whenever revising the manpage. -->
+ <!ENTITY dhdate "<date>April 12, 2001</date>">
+ <!-- SECTION should be 1-8, maybe w/ subsection other parameters are
+ allowed: see man(7), man(1). -->
+ <!ENTITY dhsection "<manvolnum>SECTION</manvolnum>">
+ <!ENTITY dhemail "<email>ivan-debian@420.am</email>">
+ <!ENTITY dhusername "Ivan Kohler">
+ <!ENTITY dhucpackage "<refentrytitle>FREESIDE</refentrytitle>">
+ <!ENTITY dhpackage "freeside">
+
+ <!ENTITY debian "<productname>Debian GNU/Linux</productname>">
+ <!ENTITY gnu "<acronym>GNU</acronym>">
+]>
+
+<refentry>
+ <refentryinfo>
+ <address>
+ &dhemail;
+ </address>
+ <author>
+ &dhfirstname;
+ &dhsurname;
+ </author>
+ <copyright>
+ <year>2001</year>
+ <holder>&dhusername;</holder>
+ </copyright>
+ &dhdate;
+ </refentryinfo>
+ <refmeta>
+ &dhucpackage;
+
+ &dhsection;
+ </refmeta>
+ <refnamediv>
+ <refname>&dhpackage;</refname>
+
+ <refpurpose>program to do something</refpurpose>
+ </refnamediv>
+ <refsynopsisdiv>
+ <cmdsynopsis>
+ <command>&dhpackage;</command>
+
+ <arg><option>-e <replaceable>this</replaceable></option></arg>
+
+ <arg><option>--example <replaceable>that</replaceable></option></arg>
+ </cmdsynopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>DESCRIPTION</title>
+
+ <para>This manual page documents briefly the
+ <command>&dhpackage;</command> and <command>bar</command>
+ commands.</para>
+
+ <para>This manual page was written for the &debian; distribution
+ because the original program does not have a manual page.
+ Instead, it has documentation in the &gnu;
+ <application>Info</application> format; see below.</para>
+
+ <para><command>&dhpackage;</command> is a program that...</para>
+
+ </refsect1>
+ <refsect1>
+ <title>OPTIONS</title>
+
+ <para>These programs follow the usual GNU command line syntax,
+ with long options starting with two dashes (`-'). A summary of
+ options is included below. For a complete description, see the
+ <application>Info</application> files.</para>
+
+ <variablelist>
+ <varlistentry>
+ <term><option>-h</option>
+ <option>--help</option>
+ </term>
+ <listitem>
+ <para>Show summary of options.</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><option>-v</option>
+ <option>--version</option>
+ </term>
+ <listitem>
+ <para>Show version of program.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>SEE ALSO</title>
+
+ <para>bar (1), baz (1).</para>
+
+ <para>The programs are documented fully by <citetitle>The Rise and
+ Fall of a Fooish Bar</citetitle> available via the
+ <application>Info</application> system.</para>
+ </refsect1>
+ <refsect1>
+ <title>AUTHOR</title>
+
+ <para>This manual page was written by &dhusername; &dhemail; for
+ the &debian; system (but may be used by others). Permission is
+ granted to copy, distribute and/or modify this document under
+ the terms of the <acronym>GNU</acronym> Free Documentation
+ License, Version 1.1 or any later version published by the Free
+ Software Foundation; with no Invariant Sections, no Front-Cover
+ Texts and no Back-Cover Texts.</para>
+
+ </refsect1>
+</refentry>
+
+<!-- Keep this comment at the end of the file
+Local variables:
+mode: sgml
+sgml-omittag:t
+sgml-shorttag:t
+sgml-minimize-attributes:nil
+sgml-always-quote-attributes:t
+sgml-indent-step:2
+sgml-indent-data:t
+sgml-parent-document:nil
+sgml-default-dtd-file:nil
+sgml-exposed-tags:nil
+sgml-local-catalogs:nil
+sgml-local-ecat-files:nil
+End:
+-->
--- /dev/null
+?package(freeside):needs=X11|text|vc|wm section=Apps/see-menu-manual\
+ title="freeside" command="/usr/bin/freeside"
--- /dev/null
+#! /bin/sh
+# postinst script for freeside
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# summary of how this script can be called:
+# * <postinst> `configure' <most-recently-configured-version>
+# * <old-postinst> `abort-upgrade' <new version>
+# * <conflictor's-postinst> `abort-remove' `in-favour' <package>
+# <new-version>
+# * <deconfigured's-postinst> `abort-deconfigure' `in-favour'
+# <failed-install-package> <version> `removing'
+# <conflicting-package> <version>
+# for details, see /usr/share/doc/packaging-manual/
+#
+# quoting from the policy:
+# Any necessary prompting should almost always be confined to the
+# post-installation script, and should be protected with a conditional
+# so that unnecessary prompting doesn't happen if a package's
+# installation fails and the `postinst' is called with `abort-upgrade',
+# `abort-remove' or `abort-deconfigure'.
+
+case "$1" in
+ configure)
+
+ ;;
+
+ abort-upgrade|abort-remove|abort-deconfigure)
+
+ ;;
+
+ *)
+ echo "postinst called with unknown argument \`$1'" >&2
+ exit 0
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
--- /dev/null
+#! /bin/sh
+# postrm script for freeside
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# summary of how this script can be called:
+# * <postrm> `remove'
+# * <postrm> `purge'
+# * <old-postrm> `upgrade' <new-version>
+# * <new-postrm> `failed-upgrade' <old-version>
+# * <new-postrm> `abort-install'
+# * <new-postrm> `abort-install' <old-version>
+# * <new-postrm> `abort-upgrade' <old-version>
+# * <disappearer's-postrm> `disappear' <r>overwrit>r> <new-version>
+# for details, see /usr/share/doc/packaging-manual/
+
+case "$1" in
+ purge|remove|upgrade|failed-upgrade|abort-install|abort-upgrade|disappear)
+
+
+ ;;
+
+ *)
+ echo "postrm called with unknown argument \`$1'" >&2
+ exit 0
+
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+
--- /dev/null
+#! /bin/sh
+# preinst script for freeside
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# summary of how this script can be called:
+# * <new-preinst> `install'
+# * <new-preinst> `install' <old-version>
+# * <new-preinst> `upgrade' <old-version>
+# * <old-preinst> `abort-upgrade' <new-version>
+#
+# For details see /usr/share/doc/packaging-manual/
+
+case "$1" in
+ install|upgrade)
+# if [ "$1" = "upgrade" ]
+# then
+# start-stop-daemon --stop --quiet --oknodo \
+# --pidfile /var/run/freeside.pid \
+# --exec /usr/sbin/freeside 2>/dev/null || true
+# fi
+ ;;
+
+ abort-upgrade)
+ ;;
+
+ *)
+ echo "preinst called with unknown argument \`$1'" >&2
+ exit 0
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
--- /dev/null
+#! /bin/sh
+# prerm script for freeside
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# summary of how this script can be called:
+# * <prerm> `remove'
+# * <old-prerm> `upgrade' <new-version>
+# * <new-prerm> `failed-upgrade' <old-version>
+# * <conflictor's-prerm> `remove' `in-favour' <package> <new-version>
+# * <deconfigured's-prerm> `deconfigure' `in-favour'
+# <package-being-installed> <version> `removing'
+# <conflicting-package> <version>
+# for details, see /usr/share/doc/packaging-manual/
+
+case "$1" in
+ remove|upgrade|deconfigure)
+# install-info --quiet --remove /usr/info/freeside.info.gz
+ ;;
+ failed-upgrade)
+ ;;
+ *)
+ echo "prerm called with unknown argument \`$1'" >&2
+ exit 0
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
--- /dev/null
+#!/usr/bin/make -f
+# Sample debian/rules that uses debhelper.
+# GNU copyright 1997 by Joey Hess.
+#
+# This version is for a hypothetical package that builds an
+# architecture-dependant package, as well as an architecture-independent
+# package.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# This is the debhelper compatability version to use.
+export DH_COMPAT=3
+
+configure: configure-stamp
+configure-stamp:
+ dh_testdir
+ # Add here commands to configure the package.
+
+
+ touch configure-stamp
+
+build: configure-stamp build-stamp
+build-stamp:
+ dh_testdir
+
+ # Add here commands to compile the package.
+ $(MAKE)
+
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp configure-stamp
+
+ # Add here commands to clean up after the build process.
+ -$(MAKE) clean
+
+ dh_clean
+
+install: DH_OPTIONS=
+install: build
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ dh_installdirs
+
+ # Add here commands to install the package into debian/freeside.
+ $(MAKE) install DESTDIR=$(CURDIR)/debian/freeside
+
+ dh_movefiles
+
+# Build architecture-independent files here.
+# Pass -i to all debhelper commands in this target to reduce clutter.
+binary-indep: build install
+ dh_testdir -i
+ dh_testroot -i
+# dh_installdebconf -i
+ dh_installdocs -i
+ dh_installexamples -i
+ dh_installmenu -i
+# dh_installlogrotate -i
+# dh_installemacsen -i
+# dh_installpam -i
+# dh_installmime -i
+# dh_installinit -i
+ dh_installcron -i
+# dh_installman -i
+ dh_installinfo -i
+# dh_undocumented -i
+ dh_installchangelogs -i
+ dh_link -i
+ dh_compress -i
+ dh_fixperms -i
+ dh_installdeb -i
+# dh_perl -i
+ dh_gencontrol -i
+ dh_md5sums -i
+ dh_builddeb -i
+
+# Build architecture-dependent files here.
+binary-arch: build install
+ dh_testdir -a
+ dh_testroot -a
+# dh_installdebconf -a
+ dh_installdocs -a
+ dh_installexamples -a
+ dh_installmenu -a
+# dh_installlogrotate -a
+# dh_installemacsen -a
+# dh_installpam -a
+# dh_installmime -a
+# dh_installinit -a
+ dh_installcron -a
+# dh_installman -a
+ dh_installinfo -a
+# dh_undocumented -a
+ dh_installchangelogs -a
+ dh_strip -a
+ dh_link -a
+ dh_compress -a
+ dh_fixperms -a
+# dh_makeshlibs -a
+ dh_installdeb -a
+# dh_perl -a
+ dh_shlibdeps -a
+ dh_gencontrol -a
+ dh_md5sums -a
+ dh_builddeb -a
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install configure
--- /dev/null
+# Example watch control file for uscan
+# Rename this file to "watch" and then you can run the "uscan" command
+# to check for upstream updates and more.
+# Site Directory Pattern Version Script
+sunsite.unc.edu /pub/Linux/Incoming freeside-(.*)\.tar\.gz debian uupdate
#!/usr/bin/perl -w
-
+#
# Template for importing legacy customer data
#
-# ivan@sisd.com 98-aug-17 - 20
+# $Id: TEMPLATE_cust_main.import,v 1.4 2001-08-21 02:44:47 ivan Exp $
use strict;
+use Date::Parse;
use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(fields qsearch qsearchs);
use FS::cust_main;
use FS::cust_pkg;
-use Date::Parse;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::pkg_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
# use these for the imported cust_main records (unless you have these in legacy
# data)
$svc{'First'} =~ s/&/and/go;
$svc{'Zip'} =~ s/\s+$//go;
- my($cust_main) = create FS::cust_main ( {
+ my($cust_main) = new FS::cust_main ( {
'custnum' => $svc{'custnum'},
'agentnum' => $agentnum,
'last' => $svc{'last'},
die $error;
}
- my($cust_pkg)=create FS::cust_pkg ( {
+ my($cust_pkg)=new FS::cust_pkg ( {
'custnum' => $svc{'custnum'},
'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
'setup' => '',
} else {
#create new cust_svc record linked to cust_pkg record
- my($n_cust_svc) = create FS::cust_svc ({
+ my($n_cust_svc) = new FS::cust_svc ({
'svcnum' => $o_cust_svc->svcnum,
'pkgnum' => $cust_pkg->pkgnum,
'svcpart' => $pkg_svc->svcpart,
warn "\n$link of $line lines linked\n";
+# ---
+
+sub usage {
+ die "Usage:\n\n cust_main.import user\n";
+}
--- /dev/null
+package FS::part_export::myexport;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_something) = (shift, shift);
+ $err_or_queue = $self->myexport_queue( $svc_something->svcnum, 'insert',
+ $svc_something->username, $svc_something->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ #return "can't change username with myexport"
+ # if $old->username ne $new->username;
+ #return '' unless $old->_password ne $new->_password;
+ $err_or_queue = $self->myexport_queue( $new->svcnum,
+ 'replace', $new->username, $new->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_delete {
+ my( $self, $svc_something ) = (shift, shift);
+ $err_or_queue = $self->myexport_queue( $svc_something->svcnum,
+ 'delete', $svc_something->username );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+#a good idea to queue anything that could fail or take any time
+sub myexport_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::myexport::myexport_$method",
+ };
+ $queue->insert( @_ ) or $queue;
+}
+
+sub myexport_insert { #subroutine, not method
+}
+sub myexport_replace { #subroutine, not method
+}
+sub myexport_delete { #subroutine, not method
+}
+
--- /dev/null
+package FS::svc_table;
+
+use strict;
+use vars qw(@ISA);
+#use FS::Record qw( qsearch qsearchs );
+use FS::svc_Common;
+use FS::cust_svc;
+
+@ISA = qw(svc_Common);
+
+=head1 NAME
+
+FS::table_name - Object methods for table_name records
+
+=head1 SYNOPSIS
+
+ use FS::table_name;
+
+ $record = new FS::table_name \%hash;
+ $record = new FS::table_name { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+ $error = $record->suspend;
+
+ $error = $record->unsuspend;
+
+ $error = $record->cancel;
+
+=head1 DESCRIPTION
+
+An FS::table_name object represents an example. FS::table_name inherits from
+FS::svc_Common. The following fields are currently supported:
+
+=over 4
+
+=item field - description
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+sub table { 'table_name'; }
+
+=item 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 L<FS::cust_svc>) should be
+defined. An FS::cust_svc record will be created and inserted.
+
+=cut
+
+sub insert {
+ my $self = shift;
+ my $error;
+
+ $error = $self->SUPER::insert;
+ return $error if $error;
+
+ '';
+}
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $error;
+
+ $error = $self->SUPER::delete;
+ return $error if $error;
+
+ '';
+}
+
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
+
+ $error = $new->SUPER::replace($old);
+ return $error if $error;
+
+ '';
+}
+
+=item suspend
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item unsuspend
+
+Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item cancel
+
+Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and repalce methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
+
+
+ ''; #no error
+}
+
+=back
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>,
+L<FS::cust_pkg>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::table_name;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::table_name - Object methods for table_name records
+
+=head1 SYNOPSIS
+
+ use FS::table_name;
+
+ $record = new FS::table_name \%hash;
+ $record = new FS::table_name { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::table_name object represents an example. FS::table_name inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item field - description
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example. To add the example to the database, see L<"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 I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'table_name'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+ my $self = shift;
+
+ ''; #no error
+}
+
+=back
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+#!/bin/sh
+
+for domain in /home/vpopmail/domains/*
+do
+ /home/vpopmail/bin/vmkpasswd `/bin/basename $domain`
+done
+
+/var/qmail/bin/qmail-newu
+
+killall -HUP qmail-send
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: megapop.pl,v 1.1 1999-04-19 10:32:44 ivan Exp $
+#
+# this will break when megapop changes the URL or format of their listing page.
+# that's stupid. perhaps they can provide a machine-readable listing?
+
+use strict;
+use LWP::UserAgent;
+use FS::UID qw(adminsuidsetup);
+use FS::svc_acct_pop;
+
+my $url = "http://www.megapop.com/location.htm";
+
+my $user = shift or die &usage;
+adminsuidsetup($user);
+
+my %state2usps = &state2usps;
+$state2usps{'WASHINGTON STATE'} = 'WA'; #megapop's on crack
+$state2usps{'CANADA'} = 'CANADA'; #freeside's on crack
+
+my $ua = new LWP::UserAgent;
+my $request = new HTTP::Request('GET', $url);
+my $response = $ua->request($request);
+die $response->error_as_HTML unless $response->is_success;
+my $line;
+my $usps = '';
+foreach $line ( split("\n", $response->content) ) {
+ if ( $line =~ /\W(\w[\w\s]*\w)\s+LOCATIONS/i ) {
+ $usps = $state2usps{uc($1)}
+ or warn "warning: unknown state $1\n";
+ } elsif ( $line =~ /(\d{3})\-(\d{3})\-(\d{4})\s+(\w[\w\s]*\w)/ ) {
+ print "$1 $2 $3 $4 $usps\n";
+ my $svc_acct_pop = new FS::svc_acct_pop ( {
+ 'city' => $4,
+ 'state' => $usps,
+ 'ac' => $1,
+ 'exch' => $2,
+ } );
+ my $error = $svc_acct_pop->insert;
+ die $error if $error;
+ }
+}
+
+sub usage {
+ die "Usage:\n $0 user\n";
+}
+
+sub state2usps{ (
+ 'ALABAMA' => 'AL',
+ 'ALASKA' => 'AK',
+ 'AMERICAN SAMOA' => 'AS',
+ 'ARIZONA' => 'AZ',
+ 'ARKANSAS' => 'AR',
+ 'CALIFORNIA' => 'CA',
+ 'COLORADO' => 'CO',
+ 'CONNECTICUT' => 'CT',
+ 'DELAWARE' => 'DE',
+ 'DISTRICT OF COLUMBIA' => 'DC',
+ 'FEDERATED STATES OF MICRONESIA' => 'FM',
+ 'FLORIDA' => 'FL',
+ 'GEORGIA' => 'GA',
+ 'GUAM' => 'GU',
+ 'HAWAII' => 'HI',
+ 'IDAHO' => 'ID',
+ 'ILLINOIS' => 'IL',
+ 'INDIANA' => 'IN',
+ 'IOWA' => 'IA',
+ 'KANSAS' => 'KS',
+ 'KENTUCKY' => 'KY',
+ 'LOUISIANA' => 'LA',
+ 'MAINE' => 'ME',
+ 'MARSHALL ISLANDS' => 'MH',
+ 'MARYLAND' => 'MD',
+ 'MASSACHUSETTS' => 'MA',
+ 'MICHIGAN' => 'MI',
+ 'MINNESOTA' => 'MN',
+ 'MISSISSIPPI' => 'MS',
+ 'MISSOURI' => 'MO',
+ 'MONTANA' => 'MT',
+ 'NEBRASKA' => 'NE',
+ 'NEVADA' => 'NV',
+ 'NEW HAMPSHIRE' => 'NH',
+ 'NEW JERSEY' => 'NJ',
+ 'NEW MEXICO' => 'NM',
+ 'NEW YORK' => 'NY',
+ 'NORTH CAROLINA' => 'NC',
+ 'NORTH DAKOTA' => 'ND',
+ 'NORTHERN MARIANA ISLANDS' => 'MP',
+ 'OHIO' => 'OH',
+ 'OKLAHOMA' => 'OK',
+ 'OREGON' => 'OR',
+ 'PALAU' => 'PW',
+ 'PENNSYLVANIA' => 'PA',
+ 'PUERTO RICO' => 'PR',
+ 'RHODE ISLAND' => 'RI',
+ 'SOUTH CAROLINA' => 'SC',
+ 'SOUTH DAKOTA' => 'SD',
+ 'TENNESSEE' => 'TN',
+ 'TEXAS' => 'TX',
+ 'UTAH' => 'UT',
+ 'VERMONT' => 'VT',
+ 'VIRGIN ISLANDS' => 'VI',
+ 'VIRGINIA' => 'VA',
+ 'WASHINGTON' => 'WA',
+ 'WEST VIRGINIA' => 'WV',
+ 'WISCONSIN' => 'WI',
+ 'WYOMING' => 'WY',
+ 'ARMED FORCES AFRICA' => 'AE',
+ 'ARMED FORCES AMERICAS' => 'AA',
+ 'ARMED FORCES CANADA' => 'AE',
+ 'ARMED FORCES EUROPE' => 'AE',
+ 'ARMED FORCES MIDDLE EAST' => 'AE',
+ 'ARMED FORCES PACIFIC' => 'AP',
+) }
+
--- /dev/null
+From http://epoch.cs.berkeley.edu:8000/sequoia/dba/montage/FAQ/SQL.html
+ by Jean Anderson (jta@postgres.berkeley.edu)
+
+What are the SQL reserved words?
+
+I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3.
+SQL3 words are not set in stone, but you'd do well to avoid them.
+
+ From sql1992.txt:
+
+ AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH,
+ COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF,
+ EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY,
+ NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS,
+ PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF,
+ REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE,
+ ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR,
+ SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE,
+ UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT
+
+ From sql1992.txt (Annex E):
+
+ ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN,
+ BIT, BIT
+
+What are the SQL reserved words?
+
+I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3.
+SQL3 words are not set in stone, but you'd do well to avoid them.
+
+ From sql1992.txt:
+
+ AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH,
+ COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF,
+ EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY,
+ NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS,
+ PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF,
+ REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE,
+ ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR,
+ SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE,
+ UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT
+
+ From sql1992.txt (Annex E):
+
+ ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN,
+ BIT, BIT
+
+What are the SQL reserved words?
+
+I grep'd the following list out of the sql docs available via anonymous ftp to speckle.ncsl.nist.gov:/isowg3.
+SQL3 words are not set in stone, but you'd do well to avoid them.
+
+ From sql1992.txt:
+
+ AFTER, ALIAS, ASYNC, BEFORE, BOOLEAN, BREADTH,
+ COMPLETION, CALL, CYCLE, DATA, DEPTH, DICTIONARY, EACH, ELSEIF,
+ EQUALS, GENERAL, IF, IGNORE, LEAVE, LESS, LIMIT, LOOP, MODIFY,
+ NEW, NONE, OBJECT, OFF, OID, OLD, OPERATION, OPERATORS, OTHERS,
+ PARAMETERS, PENDANT, PREORDER, PRIVATE, PROTECTED, RECURSIVE, REF,
+ REFERENCING, REPLACE, RESIGNAL, RETURN, RETURNS, ROLE, ROUTINE,
+ ROW, SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SIGNAL, SIMILAR,
+ SQLEXCEPTION, SQLWARNING, STRUCTURE, TEST, THERE, TRIGGER, TYPE,
+ UNDER, VARIABLE, VIRTUAL, VISIBLE, WAIT, WHILE, WITHOUT
+
+ From sql1992.txt (Annex E):
+
+ ABSOLUTE, ACTION, ADD, ALLOCATE, ALTER, ARE, ASSERTION, AT, BETWEEN,
+ BIT, BIT_LENGTH, BOTH, CASCADE, CASCADED, CASE, CAST, CATALOG,
+ CHAR_LENGTH, CHARACTER_LENGTH, COALESCE, COLLATE, COLLATION, COLUMN,
+ CONNECT, CONNECTION, CONSTRAINT, CONSTRAINTS, CONVERT, CORRESPONDING,
+ CROSS, CURRENT_DATE, CURRENT_TIME, CURRENT_TIMESTAMP, CURRENT_USER,
+ DATE, DAY, DEALLOCATE, DEFERRABLE, DEFERRED, DESCRIBE, DESCRIPTOR,
+ DIAGNOSTICS, DISCONNECT, DOMAIN, DROP, ELSE, END-EXEC, EXCEPT,
+ EXCEPTION, EXECUTE, EXTERNAL, EXTRACT, FALSE, FIRST, FULL, GET,
+ GLOBAL, HOUR, IDENTITY, IMMEDIATE, INITIALLY, INNER, INPUT,
+ INSENSITIVE, INTERSECT, INTERVAL, ISOLATION, JOIN, LAST, LEADING,
+ LEFT, LEVEL, LOCAL, LOWER, MATCH, MINUTE, MONTH, NAMES, NATIONAL,
+ NATURAL, NCHAR, NEXT, NO, NULLIF, OCTET_LENGTH, ONLY, OUTER, OUTPUT,
+ OVERLAPS, PAD, PARTIAL, POSITION, PREPARE, PRESERVE, PRIOR, READ,
+ RELATIVE, RESTRICT, REVOKE, RIGHT, ROWS, SCROLL, SECOND, SESSION,
+ SESSION_USER, SIZE, SPACE, SQLSTATE, SUBSTRING, SYSTEM_USER,
+ TEMPORARY, THEN, TIME, TIMESTAMP, TIMEZONE_HOUR, TIMEZONE_MINUTE,
+ TRAILING, TRANSACTION, TRANSLATE, TRANSLATION, TRIM, TRUE, UNKNOWN,
+ UPPER, USAGE, USING, VALUE, VARCHAR, VARYING, WHEN, WRITE, YEAR, ZONE
+
+ From sql3part2.txt (Annex E)
+
+ ACTION, ACTOR, AFTER, ALIAS, ASYNC, ATTRIBUTES, BEFORE, BOOLEAN,
+ BREADTH, COMPLETION, CURRENT_PATH, CYCLE, DATA, DEPTH, DESTROY,
+ DICTIONARY, EACH, ELEMENT, ELSEIF, EQUALS, FACTOR, GENERAL, HOLD,
+ IGNORE, INSTEAD, LESS, LIMIT, LIST, MODIFY, NEW, NEW_TABLE, NO,
+ NONE, OFF, OID, OLD, OLD_TABLE, OPERATION, OPERATOR, OPERATORS,
+ PARAMETERS, PATH, PENDANT, POSTFIX, PREFIX, PREORDER, PRIVATE,
+ PROTECTED, RECURSIVE, REFERENCING, REPLACE, ROLE, ROUTINE, ROW,
+ SAVEPOINT, SEARCH, SENSITIVE, SEQUENCE, SESSION, SIMILAR, SPACE,
+ SQLEXCEPTION, SQLWARNING, START, STATE, STRUCTURE, SYMBOL, TERM,
+ TEST, THERE, TRIGGER, TYPE, UNDER, VARIABLE, VIRTUAL, VISIBLE,
+ WAIT, WITHOUT
+
+ sql3part4.txt (ANNEX E):
+
+ CALL, DO, ELSEIF, EXCEPTION, IF, LEAVE, LOOP, OTHERS, RESIGNAL,
+ RETURN, RETURNS, SIGNAL, TUPLE, WHILE
my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
my($freeside_uid)=scalar(getpwnam('freeside'));
-$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
+$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'IFS'} = " \t\n";
$ENV{'CDPATH'} = '';
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use Getopt::Std;
+use Socket;
+use IO::Handle;
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+
+my $fs_passwdd_socket = "/usr/local/freeside/fs_passwdd_socket";
+my $freeside_uid = scalar(getpwnam('freeside'));
+
+$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+die "fs_passwd.cgi isn't running as freeside user\n" if $> != $freeside_uid;
+
+my $cgi = new CGI;
+
+$cgi->param('username') =~ /^([^\n]{0,255}$)/ or die "Illegal username";
+my $me = $1;
+
+$cgi->param('old_password') =~ /^([^\n]{0,255}$)/ or die "Illegal old_password";
+my $old_password = $1;
+
+$cgi->param('new_password') =~ /^([^\n]{0,255}$)/ or die "Illegal new_password";
+my $new_password = $1;
+
+die "New passwords don't match"
+ unless $new_password eq $cgi->param('new_password2');
+
+socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
+connect(SOCK, sockaddr_un($fs_passwdd_socket)) or die "connect: $!";
+print SOCK join("\n", $me, $old_password, $new_password, '', ''), "\n";
+SOCK->flush;
+my $error = <SOCK>;
+chomp $error;
+
+if ($error) {
+ die $error;
+} else {
+ print $cgi->header(), <<END;
+<html>
+ <head>
+ <title>Password changed</title>
+ </head>
+ <body bgcolor="#e8e8e8">
+ <h3>Password changed</h3>
+<br>Your password has been changed.
+ </body>
+</html>
+END
+}
--- /dev/null
+<html>
+ <head>
+ <title>Change password</title>
+ </head>
+ <body bgcolor="#e8e8e8">
+ <h3>Change password</h3>
+ <form action="/cgi-bin/fs_passwd.cgi" method="post">
+ <table bgcolor="#cccccc" border=0 cellspacing=2>
+ <tr><th align="right">Username</th>
+ <td><input type="text" name="username" size="18"></td>
+ </tr>
+ <tr><th align="right">Current password</th>
+ <td><input type="password" name="old_password" size="18"></td>
+ </tr>
+ <tr><th align="right">New password</th>
+ <td><input type="password" name="new_password" size="18"></td>
+ </tr>
+ <tr><th align="right">Re-enter new password</th>
+ <td><input type="password" name="new_password2" size="18"></td>
+ </tr>
+ </table>
+ <br><input type="submit" value="Change password">
+ </body>
+</html>
+
# crypt-aware, s/password/_password/; ivan@sisd.com 98-aug-23
use strict;
+use vars qw($pid);
+use subs qw(killssh);
use IO::Handle;
-use FS::SSH qw(sshopen2);
+use Net::SSH qw(sshopen2);
use FS::UID qw(adminsuidsetup);
use FS::Record qw(qsearchs);
use FS::svc_acct;
-$SIG{CHLD} = sub { wait() };
+my $user = shift or die &usage;
+adminsuidsetup $user;
-&adminsuidsetup;
+my($shellmachine)=shift or die &usage;
-my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
+#causing trouble for some folks
+#$SIG{CHLD} = sub { wait() };
+
+$SIG{HUP} = \&killssh;
+$SIG{INT} = \&killssh;
+$SIG{QUIT} = \&killssh;
+$SIG{TERM} = \&killssh;
+$SIG{PIPE} = \&killssh;
+
+sub killssh { kill 'TERM', $pid if $pid; exit; };
-my($shellmachine)=shift;
-die "Usage: fs_passwd_server shellmachine\n" unless $shellmachine;
+my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
while (1) {
my($reader,$writer)=(new IO::Handle, new IO::Handle);
$writer->autoflush(1);
- sshopen2($shellmachine,$reader,$writer,$fs_passwdd);
+ $pid = sshopen2($shellmachine,$reader,$writer,$fs_passwdd);
while (1) {
my($username,$old_password,$new_password,$new_gecos,$new_shell);
defined($username=<$reader>) or last;
unless ( $svc_acct ) { print $writer "Incorrect password.\n"; next; }
my(%hash)=$svc_acct->hash;
- my($new_svc_acct) = create FS::svc_acct ( \%hash );
+ my($new_svc_acct) = new FS::svc_acct ( \%hash );
$new_svc_acct->setfield('_password',$new_password)
if $new_password && $new_password ne $old_password;
$new_svc_acct->setfield('finger',$new_gecos) if $new_gecos;
warn "Connection to $shellmachine lost! Reconnecting...\n";
}
+sub usage {
+ die "Usage:\n\n fs_passwd_server user shellmachine\n";
+}
+
use strict;
use Socket;
-my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
+my $fs_passwdd_socket = "/usr/local/freeside/fs_passwdd_socket";
+my $pid_file = "$fs_passwdd_socket.pid";
-$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
+$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'IFS'} = " \t\n";
$ENV{'CDPATH'} = '';
bind(Server, $uaddr) or die "bind: $!";
listen(Server,SOMAXCONN) or die "listen: $!";
+if ( -e $pid_file ) {
+ open(PIDFILE,"<$pid_file");
+ #chomp( my $old_pid = <PIDFILE> );
+ my $old_pid = <PIDFILE>;
+ close PIDFILE;
+ $old_pid =~ /^(\d+)$/;
+ kill 'TERM', $1;
+}
+open(PIDFILE,">$pid_file");
+print PIDFILE "$$\n";
+close PIDFILE;
+
my($paddr);
for ( ; $paddr = accept(Client,Server); close Client) {
my($me,$old_password,$new_password,$new_gecos,$new_shell);
--- /dev/null
+Revision history for Perl extension FS::SessionClient
+
+0.01 Wed Oct 18 16:34:36 1999
+ - original version; created by ivan 1.0
+
--- /dev/null
+Changes
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+SessionClient.pm
+test.pl
+fs_sessiond
+cgi/login.cgi
+cgi/logout.cgi
+bin/freeside-login
+bin/freeside-logout
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'FS::SessionClient',
+ 'VERSION_FROM' => 'SessionClient.pm', # finds $VERSION
+ 'EXE_FILES' => [ qw(fs_sessiond bin/freeside-login bin/freeside-logout) ],
+ 'INSTALLSCRIPT' => '/usr/local/sbin',
+ 'PERM_RWX' => '750',
+);
--- /dev/null
+package FS::SessionClient;
+
+use strict;
+use vars qw($AUTOLOAD $VERSION @ISA @EXPORT_OK $fs_sessiond_socket);
+use Exporter;
+use Socket;
+use FileHandle;
+use IO::Handle;
+
+$VERSION = '0.01';
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( login logout portnum );
+
+$fs_sessiond_socket = "/usr/local/freeside/fs_sessiond_socket";
+
+$ENV{'PATH'} ='/usr/bin:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+my $freeside_uid = scalar(getpwnam('freeside'));
+die "not running as the freeside user\n" if $> != $freeside_uid;
+
+=head1 NAME
+
+FS::SessionClient - Freeside session client API
+
+=head1 SYNOPSIS
+
+ use FS::SessionClient qw( login portnum logout );
+
+ $error = login ( {
+ 'username' => $username,
+ 'password' => $password,
+ 'login' => $timestamp,
+ 'portnum' => $portnum,
+ } );
+
+ $portnum = portnum( { 'ip' => $ip } ) or die "unknown ip!"
+ $portnum = portnum( { 'nasnum' => $nasnum, 'nasport' => $nasport } )
+ or die "unknown nasnum/nasport";
+
+ $error = logout ( {
+ 'username' => $username,
+ 'password' => $password,
+ 'logout' => $timestamp,
+ 'portnum' => $portnum,
+ } );
+
+=head1 DESCRIPTION
+
+This modules provides an API for a remote session application.
+
+It needs to be run as the freeside user. Because of this, the program which
+calls these subroutines should be written very carefully.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item login HASHREF
+
+HASHREF should have the following keys: username, password, login and portnum.
+login is a UNIX timestamp; if not specified, will default to the current time.
+Starts a new session for the specified user and portnum. The password is
+optional, but must be correct if specified.
+
+Returns a scalar error message, or the empty string for success.
+
+=item portnum
+
+HASHREF should contain a single key: ip, or the two keys: nasnum and nasport.
+Returns a portnum suitable for the login and logout subroutines, or false
+on error.
+
+=item logout HASHREF
+
+HASHREF should have the following keys: usrename, password, logout and portnum.
+logout is a UNIX timestamp; if not specified, will default to the current time.
+Starts a new session for the specified user and portnum. The password is
+optional, but must be correct if specified.
+
+Returns a scalar error message, or the empty string for success.
+
+=cut
+
+sub AUTOLOAD {
+ my $hashref = shift;
+ my $method = $AUTOLOAD;
+ $method =~ s/^.*:://;
+ socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
+ connect(SOCK, sockaddr_un($fs_sessiond_socket)) or die "connect: $!";
+ print SOCK "$method\n";
+
+ print SOCK join("\n", %{$hashref}, 'END' ), "\n";
+ SOCK->flush;
+
+ chomp( my $r = <SOCK> );
+ $r;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: SessionClient.pm,v 1.3 2000-12-03 20:25:20 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<fs_sessiond>
+
+=cut
+
+1;
+
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+#false-laziness hack w freeside-logout
+
+use strict;
+use FS::SessionClient qw( login portnum );
+
+my $username = shift;
+
+my $portnum;
+if ( scalar(@ARGV) == 1 ) {
+ my $arg = shift;
+ if ( $arg =~ /^(\d+)$/ ) {
+ $portnum = $1;
+ } elsif ( $arg =~ /^([\d\.]+)$/ ) {
+ $portnum = portnum( { 'ip' => $1 } ) or die "unknown ip!"
+ } else {
+ &usage;
+ }
+} elsif ( scalar(@ARGV) == 2 ) {
+ $portnum = portnum( { 'nasnum' => shift, 'nasport' => shift } )
+ or die "unknown nasnum/nasport";
+} else {
+ &usage;
+}
+
+my $error = login ( {
+ 'username' => $username,
+ 'portnum' => $portnum,
+} );
+
+warn $error if $error;
+
+sub usage {
+ die "Usage:\n\n freeside-login username ( portnum | ip | nasnum nasport )";
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+
+#false-laziness hack w freeside-login
+
+use strict;
+use FS::SessionClient qw( logout portnum );
+
+my $username = shift;
+
+my $portnum;
+if ( scalar(@ARGV) == 1 ) {
+ my $arg = shift;
+ if ( $arg =~ /^(\d+)$/ ) {
+ $portnum = $1;
+ } elsif ( $arg =~ /^([\d\.]+)$/ ) {
+ $portnum = portnum( { 'ip' => $1 } ) or die "unknown ip!"
+ } else {
+ &usage;
+ }
+} elsif ( scalar(@ARGV) == 2 ) {
+ $portnum = portnum( { 'nasnum' => shift, 'nasport' => shift } )
+ or die "unknown nasnum/nasport";
+} else {
+ &usage;
+}
+
+my $error = logout ( {
+ 'username' => $username,
+ 'portnum' => $portnum,
+} );
+
+warn $error if $error;
+
+sub usage {
+ die "Usage:\n\n freeside-logout username ( portnum | ip | nasnum nasport )";
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+
+#false-laziness hack w logout.cgi
+
+use strict;
+use vars qw( $cgi $username $password $error $ip $portnum );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::SessionClient qw( login portnum );
+
+$cgi = new CGI;
+
+if ( defined $cgi->param('magic') ) {
+ $cgi->param('username') =~ /^\s*(\w{1,255})\s*$/ or do {
+ $error = "Illegal username";
+ &print_form;
+ exit;
+ };
+ $username = $1;
+ $cgi->param('password') =~ /^([^\n]{0,255})$/ or die "guru meditation #420";
+ $password = $1;
+ #$ip = $cgi->remote_host;
+ $ip = $ENV{REMOTE_ADDR};
+ $ip =~ /^([\d\.]+)$/ or die "illegal ip: $ip";
+ $ip = $1;
+ $portnum = portnum( { 'ip' => $1 } ) or do {
+ $error = "You appear to be coming from an unknown IP address. Verify ".
+ "that your computer is set to obtain an IP address automatically ".
+ "via DHCP.";
+ &print_form;
+ exit;
+ };
+
+ ( $error = login ( {
+ 'username' => $username,
+ 'portnum' => $portnum,
+ 'password' => $password,
+ } ) )
+ ? &print_form()
+ : &print_okay();
+
+} else {
+ $username = '';
+ $password = '';
+ $error = '';
+ &print_form;
+}
+
+sub print_form {
+ my $self_url = $cgi->self_url;
+
+ print $cgi->header( '-expires' => 'now' ), <<END;
+<HTML><HEAD><TITLE>login</TITLE></HEAD>
+<BODY BGCOLOR="#FFFFFF">
+END
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: $error</FONT>! if $error;
+
+print <<END;
+<FORM ACTION="$self_url" METHOD="POST">
+<INPUT TYPE="hidden" NAME="magic" VALUE="process">
+<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="4" ALIGN="center">
+<TR>
+ <TD ALIGN="center" COLSPAN="2">
+ <STRONG>Welcome</STRONG>
+ </TD>
+</TR>
+<TR>
+ <TD ALIGN="right">
+ Username
+ </TD>
+ <TD ALIGN="left">
+ <INPUT TYPE="text" NAME="username" VALUE="$username">
+ </TD>
+</TR>
+<TR>
+ <TD ALIGN="right">
+ Password
+ </TD>
+ <TD ALIGN="left">
+ <INPUT TYPE="password" NAME="password">
+ </TD>
+</TR>
+<TR>
+ <TD ALIGN="center" COLSPAN="2">
+ <INPUT TYPE="submit" VALUE=" Login ">
+ </TD>
+</TR>
+</TABLE>
+</FORM>
+</BODY>
+</HTML>
+END
+
+}
+
+sub print_okay {
+ print $cgi->header( '-expires' => 'now' ), <<END;
+<HTML><HEAD><TITLE>login sucessful</TITLE></HEAD>
+<BODY>login successful, etc.
+</BODY>
+</HTML>
+END
+}
+
+sub usage {
+ die "Usage:\n\n freeside-login username ( portnum | ip | nasnum nasport )";
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+
+#false-laziness hack w login.cgi
+
+use strict;
+use vars qw( $cgi $username $password $error $ip $portnum );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::SessionClient qw( logout portnum );
+
+$cgi = new CGI;
+
+if ( defined $cgi->param('magic') ) {
+ $cgi->param('username') =~ /^\s*(\w{1,255})\s*$/ or do {
+ $error = "Illegal username";
+ &print_form;
+ exit;
+ };
+ $username = $1;
+ $cgi->param('password') =~ /^([^\n]{0,255})$/ or die "guru meditation #420";
+ $password = $1;
+ #$ip = $cgi->remote_host;
+ $ip = $ENV{REMOTE_ADDR};
+ $ip =~ /^([\d\.]+)$/ or die "illegal ip: $ip";
+ $ip = $1;
+ $portnum = portnum( { 'ip' => $1 } ) or do {
+ $error = "You appear to be coming from an unknown IP address. Verify ".
+ "that your computer is set to obtain an IP address automatically ".
+ "via DHCP.";
+ &print_form;
+ exit;
+ };
+
+ ( $error = logout ( {
+ 'username' => $username,
+ 'portnum' => $portnum,
+ 'password' => $password,
+ } ) )
+ ? &print_form()
+ : &print_okay();
+
+} else {
+ $username = '';
+ $password = '';
+ $error = '';
+ &print_form;
+}
+
+sub print_form {
+ my $self_url = $cgi->self_url;
+
+ print $cgi->header( '-expires' => 'now' ), <<END;
+<HTML><HEAD><TITLE>logout</TITLE></HEAD>
+<BODY>
+END
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: $error</FONT>! if $error;
+
+print <<END;
+<FORM ACTION="$self_url" METHOD=POST>
+<INPUT TYPE="hidden" NAME="magic" VALUE="process">
+Username <INPUT TYPE="text" NAME="username" VALUE="$username"><BR>
+Password <INPUT TYPE="password" NAME="password"><BR>
+<INPUT TYPE="submit">
+</FORM>
+</BODY>
+</HTML>
+END
+
+}
+
+sub print_okay {
+ print $cgi->header( '-expires' => 'now' ), <<END;
+<HTML><HEAD><TITLE>logout sucessful</TITLE></HEAD>
+<BODY>logout successful, etc.
+</BODY>
+</HTML>
+END
+}
+
+sub usage {
+ die "Usage:\n\n freeside-logout username ( portnum | ip | nasnum nasport )";
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_sessiond
+#
+# This is run REMOTELY over ssh by fs_session_server
+#
+
+use strict;
+use Socket;
+
+use vars qw( $Debug );
+
+$Debug = 1;
+
+my $fs_sessiond_socket = "/usr/local/freeside/fs_sessiond_socket";
+
+$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+$|=1;
+
+my $me = "[fs_sessiond]";
+
+warn "$me starting\n" if $Debug;
+#nothing to read from server
+
+warn "$me creating $fs_sessiond_socket\n" if $Debug;
+my $uaddr = sockaddr_un($fs_sessiond_socket);
+my $proto = getprotobyname('tcp');
+socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
+unlink($fs_sessiond_socket);
+bind(Server, $uaddr) or die "bind: $!";
+listen(Server,SOMAXCONN) or die "listen: $!";
+
+warn "$me entering main loop\n" if $Debug;
+my $paddr;
+for ( ; $paddr = accept(Client,Server); close Client) {
+
+ chomp( my $command = <Client> );
+
+ if ( $command eq 'login' || $command eq 'logout' || $command eq 'portnum' ) {
+ warn "$me reading data from local client\n" if $Debug;
+ my @data;
+ my $dos = 0;
+ push @data, scalar(<Client>) until $dos++ == 99 || $data[$#data] eq "END\n";
+ if ( $dos == 99 ) {
+ warn "$me WARNING: DoS attempt!"
+ } else {
+ warn "$me sending data to remote server\n" if $Debug;
+ print "$command\n", @data;
+ warn "$me reading result from remote server\n" if $Debug;
+ my $error = <STDIN>;
+ warn "$me sending error to local client\n" if $Debug;
+ print Client $error;
+ }
+ } else {
+ warn "$me WARNING: unexpected command from client: $command";
+ }
+
+}
+
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+#use FS::SessionClient;
+#sigh, "not running as the freeside user"
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_session_server
+#
+
+use strict;
+use vars qw( $opt $Debug );
+use IO::Handle;
+use Net::SSH qw(sshopen2);
+use FS::UID qw(adminsuidsetup dbh);
+use FS::Record qw( qsearchs ); #qsearch );
+#use FS::cust_main_county;
+#use FS::cust_main;
+use FS::session;
+use FS::port;
+use FS::svc_acct;
+
+#require "configfile";
+$Debug = 1;
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $machine = shift or die &usage;
+
+my $fs_sessiond = "/usr/local/sbin/fs_sessiond";
+
+my $me = "[fs_session_server]";
+
+while (1) {
+ my($reader, $writer) = (new IO::Handle, new IO::Handle);
+ $writer->autoflush(1);
+ warn "$me Connecting to $machine\n" if $Debug;
+ sshopen2($machine,$reader,$writer,$fs_sessiond);
+
+ warn "$me Entering main loop\n" if $Debug;
+ while (1) {
+ warn "$me Reading (waiting for) data\n" if $Debug;
+ my $command = scalar(<$reader>);
+ chomp $command;
+ #DoS protection here too, to protect against a compromised client? *sigh*
+ my %hash;
+ while ( ( my $key = scalar(<$reader>) ) ne "END\n" ) {
+ chomp $key;
+ chomp( $hash{$key} = scalar(<$reader>) );
+ }
+
+ if ( $command eq 'login' ) {
+ my $error = &login(\%hash);
+ print $writer "$error\n";
+ } elsif ( $command eq 'logout' ) {
+ my $error = &logout(\%hash);
+ print $writer "$error\n";
+ } elsif ( $command eq 'portnum' ) {
+ my $port;
+ if ( exists $hash{'ip'} ) {
+ $hash{'ip'} =~ /^([\d\.]+)$/ or $1='nomatch';
+ $port = qsearchs('port', { 'ip' => $1 } );
+ } else {
+ $hash{'nasnum'} =~ /^(\d+)$/ and my $nasnum = $1;
+ $hash{'nasport'} =~ /^(\d+)$/ and my $nasport = $1;
+ $port = qsearchs('port', { 'nasnum'=>$nasnum, 'nasport'=>$nasport } );
+ }
+ print $writer ( $port ? $port->portnum : '' ), "\n";
+ } else {
+ warn "$me WARNING: unrecognized command: $command";
+ }
+ }
+ #won't ever reach without code above to throw out of loop, but...
+ close $writer;
+ close $reader;
+ warn "connection to $machine lost!\n";
+ sleep 5;
+ warn "reconnecting...\n";
+}
+
+sub login {
+ my $href = shift;
+ $href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username";
+ my $username = $1;
+ my $svc_acct = qsearchs('svc_acct', { 'username' => $username } )
+ or return "Unknown user";
+ return "Incorrect password"
+ if exists($href->{'password'})
+ && $href->{'password'} ne $svc_acct->_password;
+ return "Time limit exceeded" unless $svc_acct->seconds;
+ my $session = new FS::session {
+ 'portnum' => $href->{'portnum'},
+ 'svcnum' => $svc_acct->svcnum,
+ 'login' => $href->{'login'},
+ };
+ $session->insert;
+}
+
+sub logout {
+ my $href = shift;
+ $href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username";
+ my $username = $1;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+ my $svc_acct =
+ qsearchs('svc_acct', { 'username' => $username }, '', 'FOR UPDATE' )
+ or return "Unknown user";
+ return "Incorrect password"
+ if exists($href->{'password'})
+ && $href->{'password'} ne $svc_acct->_password;
+ my $session = qsearchs( 'session', {
+ 'portnum' => $href->{'portnum'},
+ 'svcnum' => $svc_acct->svcnum,
+ 'logout' => '',
+ },
+ '', 'FOR UPDATE'
+ );
+ unless ( $session ) {
+ $dbh->rollback;
+ return "No currently open sessions found for that user/port!";
+ }
+ my $nsession = new FS::session ( { $session->hash } );
+ warn "$nsession replacing $session";
+ my $error = $nsession->replace($session);
+ if ( $error ) {
+ $dbh->rollback;
+ return "can't logout: $error";
+ }
+ my $time = $nsession->logout - $nsession->login;
+ my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ my $seconds = $new_svc_acct->seconds;
+ $seconds -= $time;
+ $seconds = 0 if $seconds < 0;
+ $new_svc_acct->seconds( $seconds );
+ $error = $new_svc_acct->replace( $svc_acct );
+ warn "can't debit time: $error\n"; #don't want to rollback, though
+ $dbh->commit or die $dbh->errstr;
+ ''
+}
+
+sub usage {
+ die "Usage:\n\n fs_session_server user machine\n";
+}
+
--- /dev/null
+Revision history for Perl extension FS::SignupClient.
+
+0.01 Mon Aug 23 01:12:46 1999
+ - original version; created by h2xs 1.19
+
--- /dev/null
+Changes
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+SignupClient.pm
+test.pl
+fs_signupd
+cgi/signup.cgi
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'FS::SignupClient',
+ 'VERSION_FROM' => 'SignupClient.pm', # finds $VERSION
+ 'EXE_FILES' => [ 'fs_signupd' ],
+ 'INSTALLSCRIPT' => '/usr/local/sbin',
+ 'INSTALLSITEBIN' => '/usr/local/sbin',
+ 'PERM_RWX' => '750',
+ 'PREREQ_PM' => {
+ 'Business::CreditCard' => 0,
+ 'HTTP::BrowserDetect' => 0,
+ 'HTTP::Headers::UserAgent' => 3,
+ 'Storable' => 0,
+ 'Text::Template' => 0,
+ },
+);
--- /dev/null
+package FS::SignupClient;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT_OK $fs_signupd_socket);
+use Exporter;
+use Socket;
+use FileHandle;
+use IO::Handle;
+use Storable qw(nstore_fd fd_retrieve);
+
+$VERSION = '0.03';
+
+@ISA = qw( Exporter );
+@EXPORT_OK = qw( signup_info new_customer );
+
+$fs_signupd_socket = "/usr/local/freeside/fs_signupd_socket";
+
+$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+my $freeside_uid = scalar(getpwnam('freeside'));
+die "not running as the freeside user\n" if $> != $freeside_uid;
+
+=head1 NAME
+
+FS::SignupClient - Freeside signup client API
+
+=head1 SYNOPSIS
+
+ use FS::SignupClient qw( signup_info new_customer );
+
+ ( $locales, $packages, $pops ) = signup_info;
+
+ $error = new_customer ( {
+ 'first' => $first,
+ 'last' => $last,
+ 'ss' => $ss,
+ 'comapny' => $company,
+ 'address1' => $address1,
+ 'address2' => $address2,
+ 'city' => $city,
+ 'county' => $county,
+ 'state' => $state,
+ 'zip' => $zip,
+ 'country' => $country,
+ 'daytime' => $daytime,
+ 'night' => $night,
+ 'fax' => $fax,
+ 'payby' => $payby,
+ 'payinfo' => $payinfo,
+ 'paydate' => $paydate,
+ 'payname' => $payname,
+ 'invoicing_list' => $invoicing_list,
+ 'referral_custnum' => $referral_custnum,
+ 'pkgpart' => $pkgpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'sec_phrase' => $sec_phrase,
+ 'popnum' => $popnum,
+ 'agentnum' => $agentnum, #optional
+ } );
+
+=head1 DESCRIPTION
+
+This module provides an API for a remote signup server.
+
+It needs to be run as the freeside user. Because of this, the program which
+calls these subroutines should be written very carefully.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item signup_info
+
+Returns three array references of hash references.
+
+The first set of hash references is of allowable locales. Each hash reference
+has the following keys:
+ taxnum
+ state
+ county
+ country
+
+The second set of hash references is of allowable packages. Each hash
+reference has the following keys:
+ pkgpart
+ pkg
+
+The third set of hash references is of allowable POPs (Points Of Presence).
+Each hash reference has the following keys:
+ popnum
+ city
+ state
+ ac
+ exch
+
+(Future expansion: fourth argument is the $init_data hash reference)
+
+=cut
+
+sub signup_info {
+ socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
+ connect(SOCK, sockaddr_un($fs_signupd_socket)) or die "connect: $!";
+ print SOCK "signup_info\n";
+ SOCK->flush;
+
+ my $init_data = fd_retrieve(\*SOCK);
+ close SOCK;
+
+ (map { $init_data->{$_} } qw( cust_main_county part_pkg svc_acct_pop ) ),
+ $init_data;
+
+}
+
+=item new_customer HASHREF
+
+Adds a customer to the remote Freeside system. Requires a hash reference as
+a paramater with the following keys:
+ first
+ last
+ ss
+ comapny
+ address1
+ address2
+ city
+ county
+ state
+ zip
+ country
+ daytime
+ night
+ fax
+ payby
+ payinfo
+ paydate
+ payname
+ invoicing_list
+ referral_custnum
+ pkgpart
+ username
+ _password
+ sec_phrase
+ popnum
+
+Returns a scalar error message, or the empty string for success.
+
+=cut
+
+sub new_customer {
+ my $hashref = shift;
+
+ socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
+ connect(SOCK, sockaddr_un($fs_signupd_socket)) or die "connect: $!";
+ print SOCK "new_customer\n";
+
+ my $signup_data = { map { $_ => $hashref->{$_} } qw(
+ first last ss company address1 address2 city county state zip country
+ daytime night fax payby payinfo paydate payname invoicing_list
+ referral_custnum pkgpart username _password sec_phrase popnum
+ ) };
+
+ $signup_data->{agentnum} = $hashref->{agentnum} if $hashref->{agentnum};
+
+ nstore_fd($signup_data, \*SOCK) or die "can't send customer signup: $!";
+ SOCK->flush;
+
+ chop( my $error = <SOCK> );
+ $error;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<fs_signupd>, L<FS::cust_main>
+
+=cut
+
+1;
+
--- /dev/null
+<HTML><HEAD><TITLE>Processing error</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>Processing error</FONT><BR><BR>
+There has been an error processing your account. Please contact customer
+support.
+</BODY></HTML>
--- /dev/null
+<HTML><HEAD><TITLE>ISP Signup form</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup form</FONT><BR><BR>
+<FONT SIZE="+1" COLOR="#ff0000"><%= $error %></FONT>
+<FORM NAME="dummy">
+<INPUT TYPE="hidden" NAME="magic" VALUE="process">
+<INPUT TYPE="hidden" NAME="ref" VALUE="<%= $referral_custnum %>">
+<INPUT TYPE="hidden" NAME="ss" VALUE="">
+<INPUT TYPE="hidden" NAME="agentnum" VALUE="3">
+Contact Information
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Contact name<BR>(last, first)</TH>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="last" VALUE="<%= $last %>">,
+ <INPUT TYPE="text" NAME="first" VALUE="<%= $first %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Company</TD>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="company" SIZE=70 VALUE="<%= $company %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Address</TH>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="address1" SIZE=70 VALUE="<%= $address1 %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right"> </TD>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="address2" SIZE=70 VALUE="<%= $address2 %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>City</TH>
+ <TD><INPUT TYPE="text" NAME="city" VALUE="<%= $city %>"></TD>
+ <TH ALIGN="right"><font color="#ff0000">*</font>State/Country</TH>
+ <TD><SELECT NAME="state" SIZE="1">
+
+ <%=
+ foreach ( @{$locales} ) {
+ my $value = $_->{'state'};
+ $value .= ' ('. $_->{'county'}. ')' if $_->{'county'};
+ $value .= ' / '. $_->{'country'};
+
+ $OUT .= qq(<OPTION VALUE="$value");
+ $OUT .= ' SELECTED' if ( $state eq $_->{'state'}
+ && $county eq $_->{'county'}
+ && $country eq $_->{'country'}
+ );
+ $OUT .= ">$value</OPTION>";
+ }
+ %>
+
+ </SELECT></TD>
+ <TH><font color="#ff0000">*</font>Zip</TH>
+ <TD><INPUT TYPE="text" NAME="zip" SIZE=10 VALUE="<%= $zip %>"></TD>
+</TR>
+<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>
+</TABLE><font color="#ff0000">*</font> required fields<BR>
+
+<BR><BR>
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Username</TH>
+ <TD><INPUT TYPE="text" NAME="username" VALUE="<%= $username %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Password</TH>
+ <TD><INPUT TYPE="password" NAME="_password" VALUE="<%= $password %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Re-enter Password</TH>
+ <TD><INPUT TYPE="password" NAME="_password2" VALUE="<%= $password2 %>"></TD>
+</TR>
+
+<%= if ( $init_data->{'security_phrase'} ) {
+ <<ENDOUT;
+<TR>
+ <TD ALIGN="right">Security Phrase</TD>
+ <TD><INPUT TYPE="text" NAME="sec_phrase" VALUE="$sec_phrase">
+ </TD>
+</TR>
+ENDOUT
+ } else {
+ '<INPUT TYPE="hidden" NAME="sec_phrase" VALUE="">';
+ }
+%>
+
+<%= if ( scalar(@$pops) ) {
+ '<TR><TD ALIGN="right">Access number</TD><TD>'.
+ popselector($popnum). '</TD></TR>';
+ } else {
+ popselector($popnum);
+ }
+%>
+
+</TABLE><font color="#ff0000">*</font> required fields
+
+<BR><BR>First package
+
+ <%= use Tie::IxHash;
+ my %pkgpart2payby = map { $_->{pkgpart} => $_->{payby}[0] } @{$packages};
+ tie my %options, 'Tie::IxHash',
+ '' => '(none)',
+ map { $_->{pkgpart} => $_->{pkg} }
+ sort { $a->{recur} <=> $b->{recur} }
+ @{$packages}
+ ;
+
+ use HTML::Widgets::SelectLayers 0.02;
+ my @form_text = qw( magic ref ss agentnum
+ last first company address1 address2
+ city zip daytime night fax
+ username _password _password2 sec_phrase );
+ my @form_select = qw( state ); #county country
+ if ( scalar(@$pops) == 0 or scalar(@$pops) == 1 ) {
+ push @form_text, 'popnum',
+ } else {
+ push @form_select, 'popnum',
+ }
+ my $widget = new HTML::Widgets::SelectLayers(
+ options => \%options,
+ selected_layer => $pkgpart,
+ form_name => 'dummy',
+ form_action => $self_url,
+ form_text => \@form_text,
+ form_select => \@form_select,
+ layer_callback => sub {
+ my $layer = shift;
+ my $html = qq( <INPUT TYPE="hidden" NAME="pkgpart" VALUE="$layer">);
+
+ if ( $pkgpart2payby{$layer} eq 'BILL' ) {
+ $html .= <<ENDOUT;
+<INPUT TYPE="hidden" NAME="payby" VALUE="BILL">
+<INPUT TYPE="hidden" NAME="invoicing_list_POST" VALUE="">
+<INPUT TYPE="hidden" NAME="BILL_payinfo" VALUE="">
+<INPUT TYPE="hidden" NAME="BILL_month" VALUE="12">
+<INPUT TYPE="hidden" NAME="BILL_year" VALUE="2037">
+<INPUT TYPE="hidden" NAME="BILL_payname" VALUE="">
+<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+ENDOUT
+ } elsif ( $pkgpart2payby{$layer} eq 'CARD' ) {
+ my $postal_checked = '';
+ my @invoicing_list = split(', ', $invoicing_list );
+ $postal_checked = 'CHECKED'
+ if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list;
+
+ $invoicing_list= join(', ', grep { $_ ne 'POST' } @invoicing_list );
+
+ my $expselect = expselect("CARD", $paydate);
+
+ my $cardselect = '<SELECT NAME="CARD_type"><OPTION></OPTION>';
+ my %types = (
+ 'VISA' => 'VISA card',
+ 'MasterCard' => 'MasterCard',
+ 'Discover' => 'Discover card',
+ 'American Express' => 'American Express card',
+ );
+ foreach ( keys %types ) {
+ $selected =
+ $cgi->param('CARD_type') eq $types{$_} ? 'SELECTED' : '';
+ $cardselect .=
+ qq!<OPTION $selected VALUE="$types{$_}">$_</OPTION>!;
+ }
+ $cardselect .= '</SELECT>';
+
+ $html .= <<ENDOUT;
+<INPUT TYPE="hidden" NAME="payby" VALUE="CARD">
+<BR><BR>Billing information
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0>
+<INPUT TYPE="hidden" NAME="invoicing_list_POST" VALUE="">
+<TR>
+ <TD ALIGN="right">Email statement to </TD>
+ <TD><INPUT TYPE="text" NAME="invoicing_list" VALUE="$invoicing_list"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Credit card type</TH>
+ <TD>$cardselect</TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Card number</TH>
+ <TD><INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>*</font>Exp</TH>
+ <TD>$expselect</TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Name on card</TH>
+ <TD><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname"></TD>
+</TR>
+</TABLE>
+<font color="#ff0000">*</font> required fields
+<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+ENDOUT
+ } else {
+ $html = <<ENDOUT;
+<BR>Please select a package.<BR>
+ENDOUT
+
+ }
+
+ $html;
+
+ },
+ );
+
+ $widget->html;
+
+
+ %>
+</BODY></HTML>
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: signup.cgi,v 1.27 2002-04-25 12:03:15 ivan Exp $
+
+use strict;
+use vars qw( @payby $cgi $locales $packages $pops $init_data $error
+ $last $first $ss $company $address1 $address2 $city $state $county
+ $country $zip $daytime $night $fax $invoicing_list $payby $payinfo
+ $paydate $payname $referral_custnum
+ $pkgpart $username $password $password2 $sec_phrase $popnum
+ $agentnum
+ $ieak_file $ieak_template $cck_file $cck_template
+ $signup_html $signup_template
+ $success_html $success_template
+ $decline_html $decline_template
+ $ac $exch $loc
+ $email_name $pkg
+ $self_url
+ );
+use subs qw( print_form print_okay print_decline
+ signup_default success_default decline_default
+ expselect );
+use CGI;
+#use CGI::Carp qw(fatalsToBrowser);
+use Text::Template;
+use Business::CreditCard;
+use HTTP::Headers::UserAgent 2.00;
+use FS::SignupClient 0.03 qw( signup_info new_customer );
+
+#acceptable payment methods
+#
+#@payby = qw( CARD BILL COMP );
+#@payby = qw( CARD BILL );
+#@payby = qw( CARD );
+@payby = qw( CARD PREPAY );
+
+$ieak_file = '/usr/local/freeside/ieak.template';
+$cck_file = '/usr/local/freeside/cck.template';
+$signup_html = -e 'signup.html'
+ ? 'signup.html'
+ : '/usr/local/freeside/signup.html';
+$success_html = -e 'success.html'
+ ? 'success.html'
+ : '/usr/local/freeside/success.html';
+$decline_html = -e 'decline.html'
+ ? 'decline.html'
+ : '/usr/local/freeside/decline.html';
+
+if ( -e $ieak_file ) {
+ my $ieak_txt = Text::Template::_load_text($ieak_file)
+ or die $Text::Template::ERROR;
+ $ieak_txt =~ /^(.*)$/s; #untaint the template source - it's trusted
+ $ieak_txt = $1;
+ $ieak_template = new Text::Template ( TYPE => 'STRING', SOURCE => $ieak_txt )
+ or die $Text::Template::ERROR;
+} else {
+ $ieak_template = '';
+}
+
+if ( -e $cck_file ) {
+ my $cck_txt = Text::Template::_load_text($cck_file)
+ or die $Text::Template::ERROR;
+ $cck_txt =~ /^(.*)$/s; #untaint the template source - it's trusted
+ $cck_txt = $1;
+ $cck_template = new Text::Template ( TYPE => 'STRING', SOURCE => $cck_txt )
+ or die $Text::Template::ERROR;
+} else {
+ $cck_template = '';
+}
+
+$agentnum = '';
+if ( -e $signup_html ) {
+ my $signup_txt = Text::Template::_load_text($signup_html)
+ or die $Text::Template::ERROR;
+ $signup_txt =~ /^(.*)$/s; #untaint the template source - it's trusted
+ $signup_txt = $1;
+ $signup_template = new Text::Template ( TYPE => 'STRING',
+ SOURCE => $signup_txt,
+ DELIMITERS => [ '<%=', '%>' ]
+ )
+ or die $Text::Template::ERROR;
+ if ( $signup_txt =~
+ /<\s*INPUT TYPE="?hidden"?\s+NAME="?agentnum"?\s+VALUE="?(\d+)"?\s*>/si
+ ) {
+ $agentnum = $1;
+ }
+} else {
+ $signup_template = new Text::Template ( TYPE => 'STRING',
+ SOURCE => &signup_default,
+ DELIMITERS => [ '<%=', '%>' ]
+ )
+ or die $Text::Template::ERROR;
+}
+
+if ( -e $success_html ) {
+ my $success_txt = Text::Template::_load_text($success_html)
+ or die $Text::Template::ERROR;
+ $success_txt =~ /^(.*)$/s; #untaint the template source - it's trusted
+ $success_txt = $1;
+ $success_template = new Text::Template ( TYPE => 'STRING',
+ SOURCE => $success_txt,
+ DELIMITERS => [ '<%=', '%>' ],
+ )
+ or die $Text::Template::ERROR;
+} else {
+ $success_template = new Text::Template ( TYPE => 'STRING',
+ SOURCE => &success_default,
+ DELIMITERS => [ '<%=', '%>' ],
+ )
+ or die $Text::Template::ERROR;
+}
+
+if ( -e $decline_html ) {
+ my $decline_txt = Text::Template::_load_text($decline_html)
+ or die $Text::Template::ERROR;
+ $decline_txt =~ /^(.*)$/s; #untaint the template source - it's trusted
+ $decline_txt = $1;
+ $decline_template = new Text::Template ( TYPE => 'STRING',
+ SOURCE => $decline_txt,
+ DELIMITERS => [ '<%=', '%>' ],
+ )
+ or die $Text::Template::ERROR;
+} else {
+ $decline_template = new Text::Template ( TYPE => 'STRING',
+ SOURCE => &decline_default,
+ DELIMITERS => [ '<%=', '%>' ],
+ )
+ or die $Text::Template::ERROR;
+}
+
+
+( $locales, $packages, $pops, $init_data ) = signup_info();
+@payby = @{$init_data->{'payby'}} if @{$init_data->{'payby'}};
+$packages = $init_data->{agentnum2part_pkg}{$agentnum} if $agentnum;
+
+$cgi = new CGI;
+
+if ( defined $cgi->param('magic') ) {
+ if ( $cgi->param('magic') eq 'process' ) {
+
+ $cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/
+ or die "Oops, illegal \"state\" param: ". $cgi->param('state');
+ $state = $1;
+ $county = $3 || '';
+ $country = $4;
+
+ $payby = $cgi->param('payby');
+ $payinfo = $cgi->param( $payby. '_payinfo' );
+ $paydate =
+ $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' );
+ $payname = $cgi->param( $payby. '_payname' );
+
+ if ( $invoicing_list = $cgi->param('invoicing_list') ) {
+ $invoicing_list .= ', POST' if $cgi->param('invoicing_list_POST');
+ } else {
+ $invoicing_list = 'POST';
+ }
+
+ $error = '';
+
+ $last = $cgi->param('last');
+ $first = $cgi->param('first');
+ $ss = $cgi->param('ss');
+ $company = $cgi->param('company');
+ $address1 = $cgi->param('address1');
+ $address2 = $cgi->param('address2');
+ $city = $cgi->param('city');
+ #$county,
+ #$state,
+ $zip = $cgi->param('zip');
+ #$country,
+ $daytime = $cgi->param('daytime');
+ $night = $cgi->param('night');
+ $fax = $cgi->param('fax');
+ #$payby,
+ #$payinfo,
+ #$paydate,
+ #$payname,
+ #$invoicing_list,
+ $referral_custnum = $cgi->param('ref');
+ $pkgpart = $cgi->param('pkgpart');
+ $username = $cgi->param('username');
+ $sec_phrase = $cgi->param('sec_phrase');
+ $password = $cgi->param('_password');
+ $popnum = $cgi->param('popnum');
+ #$agentnum, # = $cgi->param('agentnum'),
+
+ if ( $cgi->param('_password') ne $cgi->param('_password2') ) {
+ $error = $init_data->{msgcat}{passwords_dont_match}; #msgcat
+ $password = '';
+ $password2 = '';
+ } else {
+ $password2 = $cgi->param('_password2');
+
+ if ( $payby eq 'CARD' && $cgi->param('CARD_type') ) {
+ $payinfo =~ s/\D//g;
+
+ $payinfo =~ /^(\d{13,16})$/
+ or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo;
+ $payinfo = $1;
+ validate($payinfo)
+ or $error ||= $init_data->{msgcat}{invalid_card}; #. $self->payinfo;
+ cardtype($payinfo) eq $cgi->param('CARD_type')
+ or $error ||= $init_data->{msgcat}{not_a}. $cgi->param('CARD_type');
+ }
+
+ $error ||= new_customer ( {
+ 'last' => $last,
+ 'first' => $first,
+ 'ss' => $ss,
+ 'company' => $company,
+ 'address1' => $address1,
+ 'address2' => $address2,
+ 'city' => $city,
+ 'county' => $county,
+ 'state' => $state,
+ 'zip' => $zip,
+ 'country' => $country,
+ 'daytime' => $daytime,
+ 'night' => $night,
+ 'fax' => $fax,
+ 'payby' => $payby,
+ 'payinfo' => $payinfo,
+ 'paydate' => $paydate,
+ 'payname' => $payname,
+ 'invoicing_list' => $invoicing_list,
+ 'referral_custnum' => $referral_custnum,
+ 'pkgpart' => $pkgpart,
+ 'username' => $username,
+ 'sec_phrase' => $sec_phrase,
+ '_password' => $password,
+ 'popnum' => $popnum,
+ 'agentnum' => $agentnum,
+ } );
+
+ }
+
+ if ( $error eq '_decline' ) {
+ print_decline();
+ } elsif ( $error ) {
+ print_form();
+ } else {
+ print_okay();
+ }
+
+ } else {
+ die "unrecognized magic: ". $cgi->param('magic');
+ }
+} else {
+ $error = '';
+ $last = '';
+ $first = '';
+ $ss = '';
+ $company = '';
+ $address1 = '';
+ $address2 = '';
+ $city = '';
+ $state = '';
+ $county = '';
+ $country = '';
+ $zip = '';
+ $daytime = '';
+ $night = '';
+ $fax = '';
+ $invoicing_list = '';
+ $payby = '';
+ $payinfo = '';
+ $paydate = '';
+ $payname = '';
+ $pkgpart = '';
+ $username = '';
+ $password = '';
+ $password2 = '';
+ $sec_phrase = '';
+ $popnum = '';
+ $referral_custnum = $cgi->param('ref') || '';
+ print_form;
+}
+
+sub print_form {
+
+ $cgi->delete('ref');
+ $self_url = $cgi->self_url;
+
+ $error = "Error: $error" if $error;
+
+ print $cgi->header( '-expires' => 'now' ),
+ $signup_template->fill_in();
+
+}
+
+sub print_decline {
+ print $cgi->header( '-expires' => 'now' ),
+ $decline_template->fill_in();
+}
+
+sub print_okay {
+ my $user_agent = new HTTP::Headers::UserAgent $ENV{HTTP_USER_AGENT};
+
+ $cgi->param('username') =~ /^(.+)$/
+ or die "fatal: invalid username got past FS::SignupClient::new_customer";
+ my $username = $1;
+ $cgi->param('_password') =~ /^(.+)$/
+ or die "fatal: invalid password got past FS::SignupClient::new_customer";
+ my $password = $1;
+ ( $cgi->param('first'). ' '. $cgi->param('last') ) =~ /^(.*)$/
+ or die "fatal: invalid email_name got past FS::SignupClient::new_customer";
+ $email_name = $1; #global for template
+
+ my $pop = pop_info($cgi->param('popnum'));
+ #or die "fatal: invalid popnum got past FS::SignupClient::new_customer";
+ if ( $pop ) {
+ ( $ac, $exch, $loc ) = ( $pop->{'ac'}, $pop->{'exch'}, $pop->{'loc'} );
+ } else {
+ ( $ac, $exch, $loc ) = ( '', '', ''); #presumably you're not using them.
+ }
+
+ #global for template
+ $pkg = ( grep { $_->{'pkgpart'} eq $pkgpart } @$packages )[0]->{'pkg'};
+
+ if ( $ieak_template
+ && $user_agent->platform eq 'ia32'
+ && $user_agent->os =~ /^win/
+ && ($user_agent->browser)[0] eq 'IE'
+ )
+ { #send an IEAK config
+ print $cgi->header('application/x-Internet-signup'),
+ $ieak_template->fill_in();
+ } elsif ( $cck_template
+ && $user_agent->platform eq 'ia32'
+ && $user_agent->os =~ /^win/
+ && ($user_agent->browser)[0] eq 'Netscape'
+ )
+ { #send a Netscape config
+ my $cck_data = $cck_template->fill_in();
+ print $cgi->header('application/x-netscape-autoconfigure-dialer-v2'),
+ map {
+ m/(.*)\s+(.*)$/;
+ pack("N", length($1)). $1. pack("N", length($2)). $2;
+ } split(/\n/, $cck_data);
+
+ } else { #send a simple confirmation
+ print $cgi->header( '-expires' => 'now' ),
+ $success_template->fill_in();
+ }
+}
+
+sub pop_info {
+ my $popnum = shift;
+ my $pop;
+ foreach $pop ( @{$pops} ) {
+ if ( $pop->{'popnum'} == $popnum ) { return $pop; }
+ }
+ '';
+}
+
+#horrible false laziness with FS/FS/svc_acct_pop.pm::popselector
+sub popselector {
+ my( $popnum, $state ) = @_;
+
+ return '<INPUT TYPE="hidden" NAME="popnum" VALUE="">' unless @$pops;
+ return $pops->[0]{city}. ', '. $pops->[0]{state}.
+ ' ('. $pops->[0]{ac}. ')/'. $pops->[0]{exch}.
+ '<INPUT TYPE="hidden" NAME="popnum" VALUE="'. $pops->[0]{popnum}. '">'
+ if scalar(@$pops) == 1;
+
+ my %pop = ();
+ push @{ $pop{$_->{state}} }, $_ foreach @$pops;
+
+ my $text = <<END;
+ <SCRIPT>
+ function opt(what,href,text) {
+ var optionName = new Option(text, href, false, false)
+ var length = what.length;
+ what.options[length] = optionName;
+ }
+
+ function popstate_changed(what) {
+ state = what.options[what.selectedIndex].text;
+ for (var i = what.form.popnum.length;i > 0;i--)
+ what.form.popnum.options[i] = null;
+ what.form.popnum.options[0] = new Option("", "", false, true);
+END
+
+ foreach my $popstate ( sort { $a cmp $b } keys %pop ) {
+ $text .= "\nif ( state == \"$popstate\" ) {\n";
+
+ foreach my $pop ( @{$pop{$popstate}}) {
+ my $o_popnum = $pop->{popnum};
+ my $poptext = $pop->{city}. ', '. $pop->{state}.
+ ' ('. $pop->{ac}. ')/'. $pop->{exch};
+
+ $text .= "opt(what.form.popnum, \"$o_popnum\", \"$poptext\");\n"
+ }
+ $text .= "}\n";
+ }
+
+ $text .= "}\n</SCRIPT>\n";
+
+ $text .=
+ qq!<SELECT NAME="popstate" SIZE=1 onChange="popstate_changed(this)">!.
+ qq!<OPTION> !;
+ $text .= "<OPTION>$_" foreach sort { $a cmp $b } keys %pop;
+ $text .= '</SELECT>'; #callback? return 3 html pieces? #'</TD><TD>';
+
+ $text .= qq!<SELECT NAME="popnum" SIZE=1><OPTION> !;
+ foreach my $pop ( @$pops ) {
+ $text .= qq!<OPTION VALUE="!. $pop->{popnum}. '"'.
+ ( ( $popnum && $pop->{popnum} == $popnum ) ? ' SELECTED' : '' ). ">".
+ $pop->{city}. ', '. $pop->{state}.
+ ' ('. $pop->{ac}. ')/'. $pop->{exch};
+ }
+ $text .= '</SELECT>';
+
+ $text;
+}
+
+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 ( 2001 .. 2037 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $y;
+ $return .= ">$_";
+ }
+ $return .= "</SELECT>";
+
+ $return;
+}
+
+sub success_default { #html to use if you don't specify a success file
+ <<'END';
+<HTML><HEAD><TITLE>Signup successful</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>Signup successful</FONT><BR><BR>
+Thanks for signing up!
+<BR><BR>
+Signup information for <%= $email_name %>:
+<BR><BR>
+Username: <%= $username %><BR>
+Password: <%= $password %><BR>
+Access number: (<%= $ac %>) / $exch - $local<BR>
+Package: <%= $pkg %><BR>
+</BODY></HTML>
+END
+}
+
+sub decline_default { #html to use if there is a decline
+ <<'END';
+<HTML><HEAD><TITLE>Processing error</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>Processing error</FONT><BR><BR>
+There has been an error processing your account. Please contact customer
+support.
+</BODY></HTML>
+END
+}
+
+sub signup_default { #html to use if you don't specify a template file
+ <<'END';
+<HTML><HEAD><TITLE>ISP Signup form</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup form</FONT><BR><BR>
+<FONT SIZE="+1" COLOR="#ff0000"><%= $error %></FONT>
+<FORM ACTION="<%= $self_url %>" METHOD=POST>
+<INPUT TYPE="hidden" NAME="magic" VALUE="process">
+<INPUT TYPE="hidden" NAME="ref" VALUE="<%= $referral_custnum %>">
+<INPUT TYPE="hidden" NAME="ss" VALUE="">
+Contact Information
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Contact name<BR>(last, first)</TH>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="last" VALUE="<%= $last %>">,
+ <INPUT TYPE="text" NAME="first" VALUE="<%= $first %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Company</TD>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="company" SIZE=70 VALUE="<%= $company %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Address</TH>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="address1" SIZE=70 VALUE="<%= $address1 %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right"> </TD>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="address2" SIZE=70 VALUE="<%= $address2 %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>City</TH>
+ <TD><INPUT TYPE="text" NAME="city" VALUE="<%= $city %>"></TD>
+ <TH ALIGN="right"><font color="#ff0000">*</font>State/Country</TH>
+ <TD><SELECT NAME="state" SIZE="1">
+
+ <%=
+ foreach ( @{$locales} ) {
+ $OUT .= '<OPTION';
+ $OUT .= ' SELECTED' if ( $state eq $_->{'state'}
+ && $county eq $_->{'county'}
+ && $country eq $_->{'country'}
+ );
+ $OUT .= '>'. $_->{'state'};
+ $OUT .= ' ('. $_->{'county'}. ')' if $_->{'county'};
+ $OUT .= ' / '. $_->{'country'};
+ }
+ %>
+
+ </SELECT></TD>
+ <TH><font color="#ff0000">*</font>Zip</TH>
+ <TD><INPUT TYPE="text" NAME="zip" SIZE=10 VALUE="<%= $zip %>"></TD>
+</TR>
+<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>
+</TABLE><font color="#ff0000">*</font> required fields<BR>
+<BR>Billing information<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR><TD>
+
+ <%=
+ $OUT .= '<INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"';
+ my @invoicing_list = split(', ', $invoicing_list );
+ $OUT .= ' CHECKED'
+ if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list;
+ $OUT .= '>';
+ %>
+
+ Postal mail invoice
+</TD></TR>
+<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="<%= join(', ', grep { $_ ne 'POST' } split(', ', $invoicing_list ) ) %>">
+</TD></TR>
+<%= scalar(@payby) > 1 ? '<TR><TD>Billing type</TD></TR>' : '' %>
+</TABLE>
+<TABLE BGCOLOR="#c0c0c0" BORDER=1 WIDTH="100%">
+<TR>
+
+ <%=
+
+ my $cardselect = '<SELECT NAME="CARD_type"><OPTION></OPTION>';
+ my %types = (
+ 'VISA' => 'VISA card',
+ 'MasterCard' => 'MasterCard',
+ 'Discover' => 'Discover card',
+ 'American Express' => 'American Express card',
+ );
+ foreach ( keys %types ) {
+ $selected = $cgi->param('CARD_type') eq $types{$_} ? 'SELECTED' : '';
+ $cardselect .= qq!<OPTION $selected VALUE="$types{$_}">$_</OPTION>!;
+ }
+ $cardselect .= '</SELECT>';
+
+ my %payby = (
+ 'CARD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("CARD"). qq!<BR><font color="#ff0000">*</font>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><font color="#ff0000">*</font>Exp !. expselect("BILL", "12-2037"). qq!<BR><font color="#ff0000">*</font>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!,
+ 'COMP' => qq!Complimentary<BR><font color="#ff0000">*</font>Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR><font color="#ff0000">*</font>Exp !. expselect("COMP"),
+ 'PREPAY' => qq!Prepaid card<BR><font color="#ff0000">*</font><INPUT TYPE="text" NAME="PREPAY_payinfo" VALUE="" MAXLENGTH=80>!,
+ );
+
+ my %paybychecked = (
+ 'CARD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("CARD", $paydate). qq!<BR><font color="#ff0000">*</font>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><font color="#ff0000">*</font>Exp !. expselect("BILL", $paydate). qq!<BR><font color="#ff0000">*</font>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
+ 'COMP' => qq!Complimentary<BR><font color="#ff0000">*</font>Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR><font color="#ff0000">*</font>Exp !. expselect("COMP", $paydate),
+ 'PREPAY' => qq!Prepaid card<BR><font color="#ff0000">*</font><INPUT TYPE="text" NAME="PREPAY_payinfo" VALUE="$payinfo" MAXLENGTH=80>!,
+ );
+
+ for (@payby) {
+ if ( scalar(@payby) == 1) {
+ $OUT .= '<TD VALIGN=TOP>'.
+ qq!<INPUT TYPE="hidden" NAME="payby" VALUE="$_">!.
+ "$paybychecked{$_}</TD>";
+ } else {
+ $OUT .= qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
+ if ($payby eq $_) {
+ $OUT .= qq! CHECKED> $paybychecked{$_}</TD>!;
+ } else {
+ $OUT .= qq!> $payby{$_}</TD>!;
+ }
+
+ }
+ }
+ %>
+
+</TR></TABLE><font color="#ff0000">*</font> required fields for each billing type
+<BR><BR>First package
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR>
+ <TD COLSPAN=2><SELECT NAME="pkgpart"><OPTION VALUE="">(none)
+
+ <%=
+ foreach my $package ( @{$packages} ) {
+ $OUT .= '<OPTION VALUE="'. $package->{'pkgpart'}. '"';
+ $OUT .= ' SELECTED' if $pkgpart && $package->{'pkgpart'} == $pkgpart;
+ $OUT .= '>'. $package->{'pkg'};
+ }
+ %>
+
+ </SELECT></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Username</TD>
+ <TD><INPUT TYPE="text" NAME="username" VALUE="<%= $username %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Password</TD>
+ <TD><INPUT TYPE="password" NAME="_password" VALUE="<%= $password %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Re-enter Password</TD>
+ <TD><INPUT TYPE="password" NAME="_password2" VALUE="<%= $password2 %>"></TD>
+</TR>
+<%=
+ if ( $init_data->{'security_phrase'} ) {
+ $OUT .= <<ENDOUT;
+<TR>
+ <TD ALIGN="right">Security Phrase</TD>
+ <TD><INPUT TYPE="text" NAME="sec_phrase" VALUE="$sec_phrase">
+ </TD>
+</TR>
+ENDOUT
+ } else {
+ $OUT .= '<INPUT TYPE="hidden" NAME="sec_phrase" VALUE="">';
+ }
+%>
+<%=
+ if ( scalar(@$pops) ) {
+ $OUT .= '<TR><TD ALIGN="right">Access number</TD><TD>'.
+ popselector($popnum). '</TD></TR>';
+ } else {
+ $OUT .= popselector($popnum);
+ }
+%>
+</TABLE>
+<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+</FORM></BODY></HTML>
+END
+}
--- /dev/null
+<HTML><HEAD><TITLE>ISP Signup form</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup form</FONT><BR><BR>
+<FONT SIZE="+1" COLOR="#ff0000"><%= $error %></FONT>
+<FORM ACTION="<%= $self_url %>" METHOD=POST>
+<INPUT TYPE="hidden" NAME="magic" VALUE="process">
+<INPUT TYPE="hidden" NAME="ref" VALUE="<%= $referral_custnum %>">
+<INPUT TYPE="hidden" NAME="ss" VALUE="">
+Contact Information
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Contact name<BR>(last, first)</TH>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="last" VALUE="<%= $last %>">,
+ <INPUT TYPE="text" NAME="first" VALUE="<%= $first %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Company</TD>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="company" SIZE=70 VALUE="<%= $company %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>Address</TH>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="address1" SIZE=70 VALUE="<%= $address1 %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right"> </TD>
+ <TD COLSPAN=5><INPUT TYPE="text" NAME="address2" SIZE=70 VALUE="<%= $address2 %>"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right"><font color="#ff0000">*</font>City</TH>
+ <TD><INPUT TYPE="text" NAME="city" VALUE="<%= $city %>"></TD>
+ <TH ALIGN="right"><font color="#ff0000">*</font>State/Country</TH>
+ <TD><SELECT NAME="state" SIZE="1">
+
+ <%=
+ foreach ( @{$locales} ) {
+ $OUT .= '<OPTION';
+ $OUT .= ' SELECTED' if ( $state eq $_->{'state'}
+ && $county eq $_->{'county'}
+ && $country eq $_->{'country'}
+ );
+ $OUT .= '>'. $_->{'state'};
+ $OUT .= ' ('. $_->{'county'}. ')' if $_->{'county'};
+ $OUT .= ' / '. $_->{'country'};
+ }
+ %>
+
+ </SELECT></TD>
+ <TH><font color="#ff0000">*</font>Zip</TH>
+ <TD><INPUT TYPE="text" NAME="zip" SIZE=10 VALUE="<%= $zip %>"></TD>
+</TR>
+<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>
+</TABLE><font color="#ff0000">*</font> required fields<BR>
+<BR>Billing information<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR><TD>
+
+ <%=
+ $OUT .= '<INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"';
+ my @invoicing_list = split(', ', $invoicing_list );
+ $OUT .= ' CHECKED'
+ if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list;
+ $OUT .= '>';
+ %>
+
+ Postal mail invoice
+</TD></TR>
+<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="<%= join(', ', grep { $_ ne 'POST' } split(', ', $invoicing_list ) ) %>">
+</TD></TR>
+<%= scalar(@payby) > 1 ? '<TR><TD>Billing type</TD></TR>' : '' %>
+</TABLE>
+<TABLE BGCOLOR="#c0c0c0" BORDER=1 WIDTH="100%">
+<TR>
+
+ <%=
+
+ my $cardselect = '<SELECT NAME="CARD_type"><OPTION></OPTION>';
+ my %types = (
+ 'VISA' => 'VISA card',
+ 'MasterCard' => 'MasterCard',
+ 'Discover' => 'Discover card',
+ 'American Express' => 'American Express card',
+ );
+ foreach ( keys %types ) {
+ $selected = $cgi->param('CARD_type') eq $types{$_} ? 'SELECTED' : '';
+ $cardselect .= qq!<OPTION $selected VALUE="$types{$_}">$_</OPTION>!;
+ }
+ $cardselect .= '</SELECT>';
+
+ my %payby = (
+ 'CARD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("CARD"). qq!<BR><font color="#ff0000">*</font>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><font color="#ff0000">*</font>Exp !. expselect("BILL", "12-2037"). qq!<BR><font color="#ff0000">*</font>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!,
+ 'COMP' => qq!Complimentary<BR><font color="#ff0000">*</font>Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR><font color="#ff0000">*</font>Exp !. expselect("COMP"),
+ 'PREPAY' => qq!Prepaid card<BR><font color="#ff0000">*</font><INPUT TYPE="text" NAME="PREPAY_payinfo" VALUE="" MAXLENGTH=80>!,
+ );
+
+ my %paybychecked = (
+ 'CARD' => qq!Credit card<BR><font color="#ff0000">*</font>$cardselect<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR><font color="#ff0000">*</font>Exp !. expselect("CARD", $paydate). qq!<BR><font color="#ff0000">*</font>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><font color="#ff0000">*</font>Exp !. expselect("BILL", $paydate). qq!<BR><font color="#ff0000">*</font>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
+ 'COMP' => qq!Complimentary<BR><font color="#ff0000">*</font>Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR><font color="#ff0000">*</font>Exp !. expselect("COMP", $paydate),
+ 'PREPAY' => qq!Prepaid card<BR><font color="#ff0000">*</font><INPUT TYPE="text" NAME="PREPAY_payinfo" VALUE="$payinfo" MAXLENGTH=80>!,
+ );
+
+ for (@payby) {
+ if ( scalar(@payby) == 1) {
+ $OUT .= '<TD VALIGN=TOP>'.
+ qq!<INPUT TYPE="hidden" NAME="payby" VALUE="$_">!.
+ "$paybychecked{$_}</TD>";
+ } else {
+ $OUT .= qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
+ if ($payby eq $_) {
+ $OUT .= qq! CHECKED> $paybychecked{$_}</TD>!;
+ } else {
+ $OUT .= qq!> $payby{$_}</TD>!;
+ }
+
+ }
+ }
+ %>
+
+</TR></TABLE><font color="#ff0000">*</font> required fields for each billing type
+<BR><BR>First package
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR>
+ <TD COLSPAN=2><SELECT NAME="pkgpart"><OPTION VALUE="">(none)
+
+ <%=
+ foreach my $package ( @{$packages} ) {
+ $OUT .= '<OPTION VALUE="'. $package->{'pkgpart'}. '"';
+ $OUT .= ' SELECTED' if $pkgpart && $package->{'pkgpart'} == $pkgpart;
+ $OUT .= '>'. $package->{'pkg'};
+ }
+ %>
+
+ </SELECT></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Username</TD>
+ <TD><INPUT TYPE="text" NAME="username" VALUE="<%= $username %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Password</TD>
+ <TD><INPUT TYPE="password" NAME="_password" VALUE="<%= $password %>"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Re-enter Password</TD>
+ <TD><INPUT TYPE="password" NAME="_password2" VALUE="<%= $password2 %>"></TD>
+</TR>
+<%=
+ if ( $init_data->{'security_phrase'} ) {
+ $OUT .= <<ENDOUT;
+<TR>
+ <TD ALIGN="right">Security Phrase</TD>
+ <TD><INPUT TYPE="text" NAME="sec_phrase" VALUE="$sec_phrase">
+ </TD>
+</TR>
+ENDOUT
+ } else {
+ $OUT .= '<INPUT TYPE="hidden" NAME="sec_phrase" VALUE="">';
+ }
+%>
+<%=
+ if ( scalar(@$pops) ) {
+ $OUT .= '<TR><TD ALIGN="right">Access number</TD><TD>'.
+ popselector($popnum). '</TD></TR>';
+ } else {
+ $OUT .= popselector($popnum);
+ }
+%>
+</TABLE>
+<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+</FORM></BODY></HTML>
--- /dev/null
+<HTML><HEAD><TITLE>Signup successful</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>Signup successful</FONT><BR><BR>
+Thanks for signing up!
+<BR><BR>
+Signup information for <%= $email_name %>:
+<BR><BR>
+Username: <%= $username %><BR>
+Password: <%= $password %><BR>
+Access number: (<%= $ac %>) / <%= $exch %> - <%= $local %><BR>
+Package: <%= $pkg %><BR>
+</BODY></HTML>
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_signupd
+#
+# This is run REMOTELY over ssh by fs_signup_server.
+
+use strict;
+use Socket;
+use Storable qw(nstore_fd fd_retrieve);
+use IO::Handle;
+
+use vars qw( $Debug );
+
+$Debug = 1;
+
+my $fs_signupd_socket = "/usr/local/freeside/fs_signupd_socket";
+my $pid_file = "$fs_signupd_socket.pid";
+
+$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+$|=1;
+
+warn "[fs_signupd] Reading init data...\n" if $Debug;
+my $init_data = fd_retrieve(\*STDIN);
+
+warn "[fs_signupd] Creating $fs_signupd_socket\n" if $Debug;
+my $uaddr = sockaddr_un($fs_signupd_socket);
+my $proto = getprotobyname('tcp');
+socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
+unlink($fs_signupd_socket);
+bind(Server, $uaddr) or die "bind: $!";
+listen(Server,SOMAXCONN) or die "listen: $!";
+
+if ( -e $pid_file ) {
+ open(PIDFILE,"<$pid_file");
+ #chomp( my $old_pid = <PIDFILE> );
+ my $old_pid = <PIDFILE>;
+ close PIDFILE;
+ $old_pid =~ /^(\d+)$/;
+ kill 'TERM', $1;
+}
+open(PIDFILE,">$pid_file");
+print PIDFILE "$$\n";
+close PIDFILE;
+
+warn "[fs_signupd] Entering main loop...\n" if $Debug;
+my $paddr;
+for ( ; $paddr = accept(Client,Server); close Client) {
+
+ chop( my $command = <Client> );
+
+ if ( $command eq "signup_info" ) {
+
+ warn "[fs_signupd] sending signup info...\n" if $Debug;
+ nstore_fd($init_data, \*Client) or die "can't send init data: $!";
+ Client->flush;
+
+ } elsif ( $command eq "new_customer" ) {
+
+ #inefficient...
+
+ warn "[fs_signupd] reading customer signup...\n" if $Debug;
+ my $signup_data = fd_retrieve(\*Client);
+
+ warn "[fs_signupd] sending customer data to remote server...\n" if $Debug;
+ nstore_fd($signup_data, \*STDOUT) or die "can't send signup data: $!";
+ STDOUT->flush;
+
+ warn "[fs_signupd] reading error from remote server...\n" if $Debug;
+ my $error = <STDIN>;
+
+ warn "[fs_signupd] sending error to local client...\n" if $Debug;
+ print Client $error;
+ Client->flush;
+
+ } else {
+ die "unexpected command from client: $command";
+ }
+
+}
+
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+#blah#use FS::SignupClient;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
--- /dev/null
+SITE_FILE 8chrfile
+SITE_NAME YourISP
+LOGIN { $username }
+PASSWORD { $password }
+PHONE_NUM +1({ $ac }){ $exch }-{ $loc }
+DNS_ADDR 10.0.0.1
+DNS_ADDR2 10.0.0.2
+NNTP_HOST news.yourisp.com
+SMTP_HOST mail.yourisp.com
+DOMAIN_NAME yourisp.com
+POP_SERVER { $username }@mail.yourisp.com
+POP_PASSWORD { $password }
+HOME_URL http://www.yourisp.com
+EMAIL_ADDR { $username }@yourisp.com
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_signup_server
+#
+
+use strict;
+use vars qw($pid);
+use IO::Handle;
+use Storable qw(nstore_fd fd_retrieve);
+use Tie::RefHash;
+use Net::SSH qw(sshopen2);
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main_county;
+use FS::cust_main;
+use FS::Msgcat qw(gettext);
+
+use vars qw( $opt $Debug );
+
+$Debug = 2;
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $conf = new FS::Conf;
+
+#my @payby = qw(CARD PREPAY);
+my @payby = $conf->config('signup_server-payby');
+my $smtpmachine = $conf->config('smtpmachine');
+
+my $machine = shift or die &usage;
+
+my $agentnum = shift or die &usage;
+my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage;
+my $pkgpart_href = $agent->pkgpart_hashref;
+
+my $refnum = shift or die &usage;
+
+#causing trouble for some folks
+#$SIG{CHLD} = sub { wait() };
+
+$SIG{HUP} = \&killssh;
+$SIG{INT} = \&killssh;
+$SIG{QUIT} = \&killssh;
+$SIG{TERM} = \&killssh;
+$SIG{PIPE} = \&killssh;
+sub killssh { kill 'TERM', $pid if $pid; exit; };
+
+my($fs_signupd)="/usr/local/sbin/fs_signupd";
+
+while (1) {
+ my($reader,$writer)=(new IO::Handle, new IO::Handle);
+ #seems to be broken - calling ->flush explicitly# $writer->autoflush(1);
+ warn "[fs_signup_server] Connecting to $machine...\n" if $Debug;
+ $pid = sshopen2($machine,$reader,$writer,$fs_signupd);
+
+ my @pops = qsearch('svc_acct_pop',{} );
+ my $init_data = {
+
+ #'_protocol' => 'signup',
+ #'_version' => '0.1',
+ #'_packet' => 'init'
+
+ 'cust_main_county' =>
+ [ map { $_->hashref } qsearch('cust_main_county', {}) ],
+
+ 'part_pkg' =>
+ [
+ #map { $_->hashref }
+ map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
+ grep { $_->svcpart('svc_acct') && $pkgpart_href->{ $_->pkgpart } }
+ qsearch( 'part_pkg', { 'disabled' => '' } )
+ ],
+
+ 'agentnum2part_pkg' =>
+ {
+ map {
+ my $href = $_->pkgpart_hashref;
+ $_->agentnum =>
+ [
+ map { { 'payby' => [ $_->payby ], %{$_->hashref} } }
+ grep { $_->svcpart('svc_acct') && $href->{ $_->pkgpart } }
+ qsearch( 'part_pkg', { 'disabled' => '' } )
+ ];
+ } qsearch('agent', {} )
+ },
+
+ 'svc_acct_pop' => [ map { $_->hashref } @pops ],
+
+ 'security_phrase' => $conf->exists('security_phrase'),
+
+ 'payby' => [ $conf->config('signup_server-payby') ],
+
+ 'msgcat' => { map { $_=>gettext($_) } qw(
+ passwords_dont_match invalid_card unknown_card_type not_a
+ ) }
+
+ };
+
+ warn "[fs_signup_server] Sending init data...\n" if $Debug;
+ nstore_fd($init_data, $writer) or die "can't send init data: $!";
+ $writer->flush;
+
+ warn "[fs_signup_server] Entering main loop...\n" if $Debug;
+ while (1) {
+ warn "[fs_signup_server] Reading (waiting for) signup data...\n" if $Debug;
+ my $signup_data = fd_retrieve($reader);
+
+ if ( $Debug > 1 ) {
+ warn join('',
+ map { " $_ => ". $signup_data->{$_}. "\n" } keys %$signup_data );
+ }
+
+ warn "[fs_signup_server] Processing signup...\n" if $Debug;
+
+ my $error = '';
+
+ #things that aren't necessary in base class, but are for signup server
+ #return "Passwords don't match"
+ # if $hashref->{'_password'} ne $hashref->{'_password2'}
+ $error ||= gettext('empty_password') unless $signup_data->{'_password'};
+ $error ||= gettext('no_access_number_selected')
+ unless $signup_data->{'popnum'} || !scalar(@pops);
+
+ #shares some stuff with htdocs/edit/process/cust_main.cgi... take any
+ # common that are still here and library them.
+ my $cust_main = new FS::cust_main ( {
+ #'custnum' => '',
+ 'agentnum' => $signup_data->{agentnum} || $agentnum,
+ 'refnum' => $refnum,
+
+ map { $_ => $signup_data->{$_} } qw(
+ last first ss company address1 address2 city county state zip country
+ daytime night fax payby payinfo paydate payname referral_custnum
+ ),
+
+ } );
+
+ $error ||= "Illegal payment type"
+ unless grep { $_ eq $signup_data->{'payby'} } @payby;
+
+ my @invoicing_list = split( /\s*\,\s*/, $signup_data->{'invoicing_list'} );
+
+ $signup_data->{'pkgpart'} =~ /^(\d+)$/ or '' =~ /^()$/;
+ my $pkgpart = $1;
+
+ my $part_pkg =
+ qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
+ or $error ||= "WARNING: unknown pkgpart: $pkgpart";
+ my $svcpart = $part_pkg->svcpart unless $error;
+
+ my $cust_pkg = new FS::cust_pkg ( {
+ #later#'custnum' => $custnum,
+ 'pkgpart' => $signup_data->{'pkgpart'},
+ } );
+ $error ||= $cust_pkg->check;
+
+ my $svc_acct = new FS::svc_acct ( {
+ 'svcpart' => $svcpart,
+ map { $_ => $signup_data->{$_} }
+ qw( username _password sec_phrase popnum ),
+ } );
+
+ my $y = $svc_acct->setdefault; # arguably should be in new method
+ $error ||= $y unless ref($y);
+
+ $error ||= $svc_acct->check;
+
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash';
+ %hash = ( $cust_pkg => [ $svc_acct ] );
+ $error ||= $cust_main->insert( \%hash, \@invoicing_list ); #msgcat
+
+ if ( ! $error && $conf->exists('signup_server-realtime') ) {
+
+ warn "[fs_signup_server] Billing customer...\n" if $Debug;
+
+ my $bill_error = $cust_main->bill;
+ warn "[fs_signup_server] error billing new customer: $bill_error"
+ if $bill_error;
+
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+
+ $bill_error = $cust_main->collect;
+ warn "[fs_signup_server] error collecting from new customer: $bill_error"
+ if $bill_error;
+
+ if ( $cust_main->balance > 0 ) {
+ #should check list for errors...
+ #$cust_main->suspend;
+ $cust_main->cancel;
+ $error = '_decline';
+ }
+ }
+
+ warn "[fs_signup_server] Sending results...\n" if $Debug;
+ print $writer $error, "\n";
+
+ next if $error;
+
+ if ( $conf->config('signup_server-email') ) {
+ warn "[fs_signup_server] Sending email...\n" if $Debug;
+
+ #false laziness w/FS::cust_bill::send & FS::cust_pay::delete
+ use Mail::Header;
+ use Mail::Internet 1.44;
+ use Date::Format;
+ my $from = $conf->config('invoice_from'); #??? as good as any
+ $ENV{MAILADDRESS} = $from;
+ my $header = new Mail::Header ( [
+ "From: $from",
+ "To: ". $conf->config('signup_server-email'),
+ "Sender: $from",
+ "Reply-To: $from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: FREESIDE NOTIFICATION: Signup Server",
+ ] );
+ my $body = [
+ "This is an automatic message from your Freeside installation\n",
+ "informing you a customer has signed up via the signup server:\n",
+ "\n",
+ 'custnum: '. $cust_main->custnum. "\n",
+ 'Name : '. $cust_main->last. ", ". $cust_main->first. "\n",
+ 'Agent : '. $cust_main->agent->agent. "\n",
+ "\n",
+ ];
+ if ( $cust_main->balance > 0 ) {
+ push @$body,
+ "This customer has an outstanding balance and has been suspended.\n";
+ }
+ my $message = new Mail::Internet ( 'Header' => $header, 'Body' => $body );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or warn "[fs_signup_server] can't send email to ".
+ $conf->config('signup_server-email').
+ " via server $smtpmachine with SMTP: $!";
+ #end-of-send mail
+ }
+
+ }
+ close $writer;
+ close $reader;
+ warn "connection to $machine lost! waiting 60 seconds...\n";
+ sleep 60;
+ warn "reconnecting...\n";
+}
+
+sub usage {
+ die "Usage:\n\n fs_signup_server user machine agentnum refnum\n";
+}
+
--- /dev/null
+[Entry]\r
+Entry_Name = The Internet\r
+[Phone]\r
+Dial_As_Is=no\r
+Phone_Number = { $exch. $loc }\r
+Area_Code = { $ac }\r
+Country_Code = 1\r
+Country_Id = 1\r
+[Server]\r
+Type = PPP\r
+SW_Compress = Yes\r
+PW_Encrypt = Yes\r
+Negotiate_TCP/IP = Yes\r
+Disable_LCP = No\r
+[TCP/IP]\r
+Specify_IP_Address = No\r
+Specity_Server_Address = No\r
+IP_Header_Compress = Yes\r
+Gateway_On_Remote = Yes\r
+[User]\r
+Name = { $username }\r
+Password = { $password }\r
+Display_Password = Yes\r
+[Internet_Mail]\r
+Email_Name = { $email_name }\r
+Email_Address = { $username }\@domain.tld\r
+POP_Server = mail.domain.tld\r
+POP_Server_Port_Number = 110\r
+POP_Login_Name = { $username }\r
+POP_Login_Password = { $password }\r
+SMTP_Server = mail.domain.tld\r
+SMTP_Server_Port_Number = 25\r
+Install_Mail = 1\r
+[Internet_News]\r
+NNTP_Server = news.domain.tld\r
+NNTP_Server_Port_Number = 119\r
+Logon_Required = No\r
+Install_News = 1\r
+[Branding]\r
+Window_Title = The Internet\r
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: register.cgi,v 1.5 2000-03-03 18:22:42 ivan Exp $
+
+use strict;
+use vars qw(
+ $datasrc $user $pass $x
+ $cgi $username $email
+ $dbh $sth
+ );
+ #$freeside_bin $freeside_test $freeside_conf
+ #@pw_set @saltset
+ #$user_pw $crypt_pw
+ #$header $msg
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use DBI;
+#use Mail::Internet;
+#use Mail::Header;
+#use Date::Format;
+
+$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+#$freeside_bin = '/home/freeside/bin/';
+#$freeside_test = '/home/freeside/test/';
+#$freeside_conf = '/usr/local/etc/freeside/';
+
+$datasrc = 'DBI:mysql:http_auth';
+$user = "freeside";
+$pass = "maelcolm";
+
+##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
+##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' );
+#@pw_set = ( 'a'..'z', '0'..'9' );
+#@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+###
+
+$cgi = new CGI;
+
+$username = $cgi->param('username');
+$username =~ /^\s*([a-z][\w]{0,15})\s*$/i
+ or &idiot("Illegal username. Please use 1-16 alphanumeric characters, and start your username with a letter.");
+$username = lc($1);
+
+$email = $cgi->param('email');
+$email =~ /^([\w\-\.\+]+\@[\w\-\.]+)$/
+ or &idiot("Illegal email address.");
+$email = $1;
+
+###
+
+#$user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+#$crypt_pw = crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]);
+
+###
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+###
+
+$dbh = DBI->connect( $datasrc, $user, $pass, {
+ 'AutoCommit' => 'true',
+} ) or die "DBI->connect error: $DBI::errstr\n";
+$x = $DBI::errstr; #silly; to avoid "used only once" warning
+
+$sth = $dbh->prepare("INSERT INTO mysql_auth VALUES (". join(", ",
+ $dbh->quote($username),
+# $dbh->quote("X"),
+# $dbh->quote($crypt_pw),
+ $dbh->quote($email),
+ $dbh->quote('freeside'),
+ $dbh->quote('unconfigured'),
+). ")" );
+
+$sth->execute or &idiot("Username in use: ". $sth->errstr);
+
+$dbh->disconnect or die $dbh->errstr;
+
+###
+
+$|=1;
+print $cgi->header;
+print <<END;
+<HTML>
+ <HEAD>
+ <TITLE>Freeside demo registration successful</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#FFFFFF">
+ <table>
+ <tr><td>
+ <p align=center>
+ <img border=0 alt="Silicon Interactive Software Design" src="http://www.sisd.com/freeside/small-logo.gif">
+ </td><td>
+ <center><font color="#ff0000" size=7>freeside demo registration successful</font></center>
+ </td></tr>
+ </table>
+ <P>Your sample database has been setup. Your password and the URL for the
+ Freeside demo have been emailed to you.
+ </BODY>
+</HTML>
+END
+
+###
+
+sub idiot {
+ my($error)=@_;
+ print $cgi->header, <<END;
+<HTML>
+ <HEAD>
+ <TITLE>Registration error</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#FFFFFF">
+ <CENTER>
+ <H4>Registration error</H4>
+ </CENTER>
+ <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;
+
+}
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>
+ Freeside - Billing and account administration software for ISPs
+ </TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#ffffff">
+ <table>
+ <tr><td>
+ <A HREF="http://www.sisd.com/">
+ <IMG BORDER=0 SRC="small-logo.gif" ALIGN=LEFT>
+ </A>
+ </td><td>
+ <center><font color="#ff0000" size=7 size=+4>freeside demo registration</font></center>
+ </td></tr>
+ </table>
+<P>You will need to choose a username for access to the Freeside web demo.
+
+<P><FONT SIZE=+1 COLOR="#ff0000">A password
+ and the URL for your demo will be emailed to you, so don't waste your
+ time with non-deliverable addresses.</FONT>
+We will <B>not</B> give your email address to any third party,
+ nor will we send you any unsolicited email (or in fact any email after the automatic registration).
+ <FORM ACTION="register.cgi" METHOD="POST">
+ <PRE>
+Freeside username: <INPUT TYPE="text" NAME="username" MAXLENGTH=16>
+
+Email address: <INPUT TYPE="text" NAME="email">
+</PRE>
+<BR><INPUT TYPE="Submit" VALUE="Register">
+ </FORM>
+ </BODY>
+</HTML>
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: registerd,v 1.8 2000-03-03 12:27:54 ivan Exp $
+
+use strict;
+use vars qw(
+ $freeside_conf
+ $mysql_data
+ $datasrc $user $pass $x
+ $dbh $sth
+ @pw_set @saltset
+ $header $msg
+ );
+ # $freeside_bin $freeside_test
+ # $cgi $username $name $email $user_pw $crypt_pw
+#use CGI;
+#use CGI::Carp qw(fatalsToBrowser);
+use DBI;
+use Mail::Internet;
+use Mail::Header;
+use Date::Format;
+
+#$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+#$ENV{'SHELL'} = '/bin/sh';
+#$ENV{'IFS'} = " \t\n";
+#$ENV{'CDPATH'} = '';
+#$ENV{'ENV'} = '';
+#$ENV{'BASH_ENV'} = '';
+
+#$freeside_bin = '/home/freeside/bin/';
+#$freeside_test = '/home/freeside/test/';
+$freeside_conf = '/usr/local/etc/freeside/';
+
+$mysql_data = "/var/lib/mysql";
+
+$datasrc = 'DBI:mysql:http_auth';
+$user = "freeside";
+$pass = "maelcolm";
+
+#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
+#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' );
+@pw_set = ( 'a'..'z', '0'..'9' );
+@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+#die "not running as system user freeside"
+# unless $> == scalar(getpwnam('freeside'));
+die "not running as root user"
+ unless $> == 0;
+
+$dbh = DBI->connect( $datasrc, $user, $pass, {
+ 'AutoCommit' => 'true',
+} ) or die "DBI->connect error: $DBI::errstr\n";
+$x = $DBI::errstr; #silly; to avoid "used only once" warning
+
+while ( 1 ) {
+
+ $SIG{HUP} = 'IGNORE';
+ $SIG{INT} = 'IGNORE';
+ $SIG{QUIT} = 'IGNORE';
+ $SIG{TERM} = 'IGNORE';
+ $SIG{TSTP} = 'IGNORE';
+ $SIG{PIPE} = 'IGNORE';
+
+ $sth = $dbh->prepare("LOCK TABLES mysql_auth WRITE");
+ $sth->execute or die $sth->errstr;
+
+ $sth = $dbh->prepare(
+ 'SELECT * FROM mysql_auth WHERE status = "unconfigured"'
+ );
+ $sth->execute or die $sth->errstr;
+ my $pending = $sth->fetchall_arrayref( {} );
+
+ $sth = $dbh->prepare(
+ 'UPDATE mysql_auth SET status = "locked" WHERE status = "unconfigured"'
+ );
+ $sth->execute or die $sth->errstr;
+
+ $sth = $dbh->prepare("UNLOCK TABLES");
+ $sth->execute or die $sth->errstr;
+
+ #
+
+ foreach my $row ( @{$pending} ) {
+
+ my $username = $row->{'username'};
+ my $email = $row->{'passwd'};
+
+ system("/usr/bin/mysqladmin --user=$user --password=$pass ".
+ "create demo_$username >/dev/null");
+
+ system "cp -p $mysql_data/demo_template/* $mysql_data/demo_$username";
+
+ mkdir "${freeside_conf}conf.DBI:mysql:demo_$username", 0755;
+ system "cp -pr ${freeside_conf}conf.DBI:mysql:demo_template/* ".
+ "${freeside_conf}conf.DBI:mysql:demo_$username";
+
+ mkdir "${freeside_conf}counters.DBI:mysql:demo_$username", 0755;
+ system "cp -p ${freeside_conf}counters.DBI:mysql:demo_template/* ".
+ "${freeside_conf}counters.DBI:mysql:demo_$username";
+ chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')),
+ "${freeside_conf}counters.DBI:mysql:demo_$username";
+
+ system "cp -p ${freeside_conf}dbdef.DBI:mysql:demo_template ".
+ "${freeside_conf}dbdef.DBI:mysql:demo_$username";
+
+ open(INVOICE_FROM, ">${freeside_conf}conf.DBI:mysql:demo_$username/invoice_from")
+ or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/invoice_from: $!";
+ print INVOICE_FROM "$email\n";
+ close INVOICE_FROM;
+
+ open(LPR, ">${freeside_conf}conf.DBI:mysql:demo_$username/lpr")
+ or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/lpr: $!";
+ print LPR "mail $email";
+ close LPR;
+
+ open(FROM, ">${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/from")
+ or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/from: $!";
+ print FROM "$email\n";
+ close FROM;
+
+ open(TO, ">${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/to")
+ or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/to: $!";
+ print TO "$email\n";
+ close TO;
+
+ open(SECRETS, ">${freeside_conf}secrets.demo_$username")
+ or die "Can\'t open ${freeside_conf}secrets.demo_$username: $!";
+ chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')),
+ "${freeside_conf}secrets.demo_$username";
+ chmod 0600, "${freeside_conf}secrets.demo_$username";
+ print SECRETS "DBI:mysql:demo_$username\nfreeside\nmaelcolm\n";
+ close SECRETS;
+
+ open(MAPSECRETS, ">>${freeside_conf}mapsecrets")
+ or die "Can\'t open ${freeside_conf}mapsecrets: $!";
+ print MAPSECRETS "$username secrets.demo_$username\n";
+ close MAPSECRETS;
+
+ my $user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+ my $crypt_pw =
+ crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]);
+
+ $sth = $dbh->prepare(
+ qq(UPDATE mysql_auth SET passwd = "$crypt_pw", status = "done" WHERE username = "$username")
+ );
+ $sth->execute or die $sth->errstr;
+
+ $ENV{SMTPHOSTS} = "localhost";
+ $ENV{MAILADDRESS} = 'ivan-fsreg@sisd.com';
+ $ENV{TZ} = "PST8PDT";
+ $header = Mail::Header->new( [
+ 'From: ivan-fsreg@sisd.com',
+ "To: $email",
+ 'Bcc: ivan-fsreg_bcc@sisd.com',
+ 'Sender: ivan-fsreg@sisd.com',
+ 'Reply-To: ivan-fsreg@sisd.com',
+ #'Date: '. time2str("%a, %d %b %Y %X %z", time ),
+ 'Date: '. time2str("%a, %d %b %Y %X ", time ). "-0800",
+ 'Subject: Freeside demo information',
+ ] );
+ $msg = Mail::Internet->new(
+ 'Header' => $header,
+ 'Body' => [
+ "Hello,\n",
+ "\n",
+ "Your sample Freeside database has been setup.\n",
+ "\n",
+ "Point your web browswer at http://freeside.sisd.com/ and use the following\n",
+ "authentication information:\n",
+ "\n",
+ "Username: $username\n",
+ "Password: $user_pw\n",
+ "\n",
+ "-- \n",
+ "ivan\n",
+ ]
+ );
+ $msg->smtpsend or die "Can\'t send registration email!";
+
+ }
+
+ $SIG{HUP} = 'DEFAULT';
+ $SIG{INT} = 'DEFAULT';
+ $SIG{QUIT} = 'DEFAULT';
+ $SIG{TERM} = 'DEFAULT';
+ $SIG{TSTP} = 'DEFAULT';
+ $SIG{PIPE} = 'DEFAULT';
+
+ sleep 5;
+
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: registerd.Pg,v 1.11 2001-10-24 15:29:30 ivan Exp $
+
+use strict;
+use vars qw(
+ $freeside_conf
+ $mysql_data
+ $datasrc $user $pass $x
+ $dbh $sth
+ @pw_set @saltset
+ $header $msg
+ );
+ # $freeside_bin $freeside_test
+ # $cgi $username $name $email $user_pw $crypt_pw
+#use CGI;
+#use CGI::Carp qw(fatalsToBrowser);
+use DBI;
+use Mail::Internet;
+use Mail::Header;
+use Date::Format;
+
+#$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+#$ENV{'SHELL'} = '/bin/sh';
+#$ENV{'IFS'} = " \t\n";
+#$ENV{'CDPATH'} = '';
+#$ENV{'ENV'} = '';
+#$ENV{'BASH_ENV'} = '';
+
+#$freeside_bin = '/home/freeside/bin/';
+#$freeside_test = '/home/freeside/test/';
+$freeside_conf = '/usr/local/etc/freeside/';
+
+#$mysql_data = "/var/lib/mysql";
+
+$datasrc = 'DBI:mysql:http_auth';
+$user = "freeside";
+$pass = "maelcolm";
+
+#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
+#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' );
+@pw_set = ( 'a'..'z', '0'..'9' );
+@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+#die "not running as system user freeside"
+# unless $> == scalar(getpwnam('freeside'));
+die "not running as root user"
+ unless $> == 0;
+
+$dbh = DBI->connect( $datasrc, $user, $pass, {
+ 'AutoCommit' => 'true',
+} ) or die "DBI->connect error: $DBI::errstr\n";
+#$x = $DBI::errstr; #silly; to avoid "used only once" warning
+
+while ( 1 ) {
+
+ $SIG{HUP} = 'IGNORE';
+ $SIG{INT} = 'IGNORE';
+ $SIG{QUIT} = 'IGNORE';
+ $SIG{TERM} = 'IGNORE';
+ $SIG{TSTP} = 'IGNORE';
+ $SIG{PIPE} = 'IGNORE';
+
+ $sth = $dbh->prepare("LOCK TABLES mysql_auth WRITE");
+ $sth->execute or die $sth->errstr;
+
+ $sth = $dbh->prepare(
+ 'SELECT * FROM mysql_auth WHERE status = "unconfigured"'
+ );
+ $sth->execute or die $sth->errstr;
+ my $pending = $sth->fetchall_arrayref( {} );
+
+ $sth = $dbh->prepare(
+ 'UPDATE mysql_auth SET status = "locked" WHERE status = "unconfigured"'
+ );
+ $sth->execute or die $sth->errstr;
+
+ $sth = $dbh->prepare("UNLOCK TABLES");
+ $sth->execute or die $sth->errstr;
+
+ #
+
+ foreach my $row ( @{$pending} ) {
+
+ my $username = $row->{'username'};
+ my $email = $row->{'passwd'};
+
+ my $pdbh = DBI->connect( 'DBI:Pg:host=localhost;dbname=demo_template', 'freeside', 'maelcolm' )
+ or do { &myerr("$username: ". $DBI::errstr); next; };
+
+ my $psth = $pdbh->prepare("CREATE DATABASE demo_$username")
+ or do { &myerr("$username: ". $pdbh->errstr); next; };
+ $psth->execute()
+ or do { &myerr("$username: ". $psth->errstr); next; };
+
+ $pdbh->disconnect
+ or do { &myerr("fatal: $DBI::errstr"); die; };
+
+ open(PSQL,"|psql -U freeside demo_$username")
+ or do { &myerr("|psql -U freeside demo_$username: $!"); next; };
+ open(PSQLDATA, "</usr/local/etc/freeside/demo_template.Pg")
+ or do { &myerr("/usr/local/etc/freeside/demo_template.Pg: $!"); next; };
+ while(<PSQLDATA>) {
+ print PSQL $_;
+ }
+ close PSQLDATA
+ or do { &myerr("/usr/local/etc/freeside/demo_template.Pg: $!"); next; };
+ close PSQL
+ or do { &myerr("|psql -U freeside demo_$username: $!"); next; };
+
+ mkdir "${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username", 0755;
+ system "cp -pr ${freeside_conf}conf.DBI:Pg:host=localhost\\;dbname=demo_template/* ".
+ "${freeside_conf}conf.DBI:Pg:host=localhost\\;dbname=demo_$username";
+
+ mkdir "${freeside_conf}counters.DBI:Pg:host=localhost;dbname=demo_$username", 0755;
+ system "cp -p ${freeside_conf}counters.DBI:Pg:host=localhost\\;dbname=demo_template/* ".
+ "${freeside_conf}counters.DBI:Pg:host=localhost\\;dbname=demo_$username";
+ chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')),
+ "${freeside_conf}counters.DBI:Pg:host=localhost;dbname=demo_$username";
+
+ system "cp -p ${freeside_conf}dbdef.DBI:Pg:host=localhost\\;dbname=demo_template ".
+ "${freeside_conf}dbdef.DBI:Pg:host=localhost\\;dbname=demo_$username";
+
+ open(INVOICE_FROM, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/invoice_from")
+ or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/invoice_from: $!";
+ print INVOICE_FROM "$email\n";
+ close INVOICE_FROM;
+
+ open(LPR, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/lpr")
+ or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/lpr: $!";
+ print LPR "mail $email";
+ close LPR;
+
+# open(FROM, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/from")
+# or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/from: $!";
+# print FROM "$email\n";
+# close FROM;
+#
+# open(TO, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/to")
+# or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/to: $!";
+# print TO "$email\n";
+# close TO;
+
+ open(SECRETS, ">${freeside_conf}secrets.demo_$username")
+ or die "Can\'t open ${freeside_conf}secrets.demo_$username: $!";
+ chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')),
+ "${freeside_conf}secrets.demo_$username";
+ chmod 0600, "${freeside_conf}secrets.demo_$username";
+ print SECRETS "DBI:Pg:host=localhost;dbname=demo_$username\nfreeside\nmaelcolm\n";
+ close SECRETS;
+
+ open(MAPSECRETS, ">>${freeside_conf}mapsecrets")
+ or die "Can\'t open ${freeside_conf}mapsecrets: $!";
+ print MAPSECRETS "$username secrets.demo_$username\n";
+ close MAPSECRETS;
+
+ my $user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+ my $crypt_pw =
+ crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]);
+
+ $sth = $dbh->prepare(
+ qq(UPDATE mysql_auth SET passwd = "$crypt_pw", status = "done" WHERE username = "$username")
+ );
+ $sth->execute or die $sth->errstr;
+
+ #$ENV{SMTPHOSTS} = "localhost";
+ $ENV{SMTPHOSTS} = "192.168.1.1";
+ $ENV{MAILADDRESS} = 'ivan-fsreg@sisd.com';
+ $ENV{TZ} = "PST8PDT";
+ $header = Mail::Header->new( [
+ 'From: ivan-fsreg@sisd.com',
+ "To: $email",
+ 'Bcc: ivan-fsreg_bcc@sisd.com',
+ 'Sender: ivan-fsreg@sisd.com',
+ 'Reply-To: ivan-fsreg@sisd.com',
+ #'Date: '. time2str("%a, %d %b %Y %X %z", time ),
+ 'Date: '. time2str("%a, %d %b %Y %X ", time ). "-0800",
+ 'Subject: Freeside demo information',
+ ] );
+ $msg = Mail::Internet->new(
+ 'Header' => $header,
+ 'Body' => [
+ "Hello,\n",
+ "\n",
+ "Your sample Freeside database has been setup.\n",
+ "\n",
+ "Your login and database will be automatically deleted in 1-2 months.\n",
+ "\n",
+ "Point your web browswer at http://freeside.sisd.com/ and use the following\n",
+ "authentication information:\n",
+ "\n",
+ "Username: $username\n",
+ "Password: $user_pw\n",
+ "\n",
+ "-- \n",
+ "ivan\n",
+ ]
+ );
+ $msg->smtpsend or die "Can\'t send registration email!";
+
+ }
+
+ $SIG{HUP} = 'DEFAULT';
+ $SIG{INT} = 'DEFAULT';
+ $SIG{QUIT} = 'DEFAULT';
+ $SIG{TERM} = 'DEFAULT';
+ $SIG{TSTP} = 'DEFAULT';
+ $SIG{PIPE} = 'DEFAULT';
+
+ sleep 5;
+
+}
+
+sub myerr {
+ my $msg = shift;
+ open(MAIL,"|mail ivan-fsdemoerr\@420.am");
+ print MAIL $msg, "\n\n";
+ print MAIL $msg, "\n\n";
+ close MAIL;
+};
+
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent.cgi: browse agent
-#
-# ivan@sisd.com 97-dec-12
-#
-# changes to allow pages to load from a relative location in the web tree.
-# bmccane@maxbaud.net 98-mar-25
-#
-# changed 'type' to 'atype' because type is reserved word in Pg6.3
-# bmccane@maxbaud.net 98-apr-3
-#
-# agent type was linking to wrong cgi ivan@sisd.com 98-jul-18
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header('Agent Listing', menubar(
- 'Main Menu' => '../',
- 'Add new agent' => '../edit/agent.cgi'
-)), <<END;
- <BR>
- Click on agent number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>Agent #</FONT></TH>
- <TH>Agent</TH>
- <TH>Type</TH>
- <TH><FONT SIZE=-1>Freq. (unimp.)</FONT></TH>
- <TH><FONT SIZE=-1>Prog. (unimp.)</FONT></TH>
- </TR>
-END
-
-my($agent);
-foreach $agent ( sort {
- $a->getfield('agentnum') <=> $b->getfield('agentnum')
-} qsearch('agent',{}) ) {
- my($hashref)=$agent->hashref;
- my($typenum)=$hashref->{typenum};
- my($agent_type)=qsearchs('agent_type',{'typenum'=>$typenum});
- my($atype)=$agent_type->getfield('atype');
- print <<END;
- <TR>
- <TD><A HREF="../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>$hashref->{freq}</TD>
- <TD>$hashref->{prog}</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent_type.cgi: browse agent_type
-#
-# ivan@sisd.com 97-dec-10
-#
-# Changes to allow page to work at a relative position in server
-# Changes to make "Packages" display 2-wide in table (old way was too vertical)
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&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>
- <TR>
- <TH><FONT SIZE=-1>Type #</FONT></TH>
- <TH>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',{}) ) {
- my($hashref)=$agent_type->hashref;
- my(@type_pkgs)=qsearch('type_pkgs',{'typenum'=> $hashref->{typenum} });
- my($rowspan)=scalar(@type_pkgs);
- $rowspan = int($rowspan/2+0.5) ;
- print <<END;
- <TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/agent_type.cgi?$hashref->{typenum}">
- $hashref->{typenum}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{atype}</TD>
-END
-
- my($type_pkgs);
- my($tdcount) = -1 ;
- foreach $type_pkgs ( @type_pkgs ) {
- my($pkgpart)=$type_pkgs->getfield('pkgpart');
- 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">!,
- $part_pkg->getfield('pkg'),"</A></TD>";
- $tdcount ++ ;
- if ($tdcount == 2)
- {
- print qq!</TR>\n! ;
- $tdcount = 0 ;
- }
- }
-
- print "</TR>";
-}
-
-print <<END;
- </TR></TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main_county.cgi: browse cust_main_county
-#
-# ivan@sisd.com 97-dec-13
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header("Tax Rate Listing", menubar(
- 'Main Menu' => '../',
- 'Edit tax rates' => "../edit/cust_main_county.cgi",
-)),<<END;
- <BR>Click on <u>expand</u> to specify tax rates by county.
- <P><TABLE BORDER>
- <TR>
- <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>
-END
-
- print "<TD>", $hashref->{county}
- ? $hashref->{county}
- : qq!(ALL) <FONT SIZE=-1>!.
- qq!<A HREF="../edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
- qq!">expand</A></FONT>!
- , "</TD>";
-
- print <<END;
- <TD>$hashref->{tax}%</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_svc.cgi: browse part_pkg
-#
-# ivan@sisd.com 97-dec-5,9
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-print header("Package Part Listing",menubar(
- 'Main Menu' => '../',
- 'Add new package' => "../edit/part_pkg.cgi",
-)), <<END;
- <BR>Click on package part number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>Part #</FONT></TH>
- <TH>Package</TH>
- <TH>Comment</TH>
- <TH><FONT SIZE=-1>Setup Fee</FONT></TH>
- <TH><FONT SIZE=-1>Freq.</FONT></TH>
- <TH><FONT SIZE=-1>Recur. Fee</FONT></TH>
- <TH>Service</TH>
- <TH><FONT SIZE=-1>Quan.</FONT></TH>
- </TR>
-END
-
-my($part_pkg);
-foreach $part_pkg ( sort {
- $a->getfield('pkgpart') <=> $b->getfield('pkgpart')
-} qsearch('part_pkg',{}) ) {
- my($hashref)=$part_pkg->hashref;
- my(@pkg_svc)=grep $_->getfield('quantity'),
- qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} });
- my($rowspan)=scalar(@pkg_svc);
- print <<END;
- <TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/part_pkg.cgi?$hashref->{pkgpart}">
- $hashref->{pkgpart}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{pkg}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{setup}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{recur}</TD>
-END
-
- my($pkg_svc);
- 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">!,
- $part_svc->getfield('svc'),"</A></TD><TD>",
- $pkg_svc->getfield('quantity'),"</TD></TR><TR>\n";
- }
-
- print "</TR>";
-}
-
-print <<END;
- </TR></TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_referral.cgi: Browse part_referral
-#
-# ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&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>
- <TR>
- <TH><FONT SIZE=-1>Referral #</FONT></TH>
- <TH>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}">
- $hashref->{refnum}</A></TD>
- <TD>$hashref->{referral}</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_svc.cgi: browse part_svc
-#
-# ivan@sisd.com 97-nov-14, 97-dec-9
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-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);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header('Service Part Listing', menubar(
- 'Main Menu' => '../',
- 'Add new service' => "../edit/part_svc.cgi",
-)),<<END;
- <BR>Click on service part number to edit.
- <TABLE BORDER>
- <TR>
- <TH>Part #</TH>
- <TH>Service</TH>
- <TH>Table</TH>
- <TH>Field</TH>
- <TH>Action</TH>
- <TH>Value</TH>
- </TR>
-END
-
-my($part_svc);
-foreach $part_svc ( sort {
- $a->getfield('svcpart') <=> $b->getfield('svcpart')
-} qsearch('part_svc',{}) ) {
- my($hashref)=$part_svc->hashref;
- my($svcdb)=$hashref->{svcdb};
- my(@rows)=
- grep $hashref->{${svcdb}.'__'.$_.'_flag'},
- map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc')
- ;
- my($rowspan)=scalar(@rows);
- 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>$hashref->{svcdb}</TD>
-END
- my($row);
- foreach $row ( @rows ) {
- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print "<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 "</TR>";
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_pop.cgi: browse pops
-#
-# ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&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>
- <TR>
- <TH><FONT SIZE=-1>POP #</FONT></TH>
- <TH>City</TH>
- <TH>State</TH>
- <TH>Area code</TH>
- <TH>Exchange</TH>
- </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}">
- $hashref->{popnum}</A></TD>
- <TD>$hashref->{city}</TD>
- <TD>$hashref->{state}</TD>
- <TD>$hashref->{ac}</TD>
- <TD>$hashref->{exch}</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-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);
- }
-
+++ /dev/null
-<head>
- <title>Administration</title>
-</head>
-<body>
- <h1>Administration</h1>
-</body>
+++ /dev/null
-<head>
- <title>Billing</title>
-</head>
-<body>
- <h1>Billing</h1>
- The bin/bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ]
- <ul>
- <li>-c: Turn on collecting (you probably want this).
- <li>-i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards. Not available without modifying site_perl/Bill.pm
- <li>-d: Pretend it is <i>date</i> (parsed by Date::Parse)
- <li>-b: N/A
- </ul>
- Printing should be configured on your freeside machine to print invoices.
- <br><br>Batch credit card processing
- <ul>
- <li>After this script is run, a credit card batch will be in the <a href="schema.html#cust_pay_batch">cust_pay_batch</a> table. Export this table to your credit card batching.
- <li>When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the <a href="schema.html#cust_pay">cust_pay</a> table. Example code to add payments is:
- <pre>use FS::cust_pay;
-
-# loop over all records in batch
-
-my $payment=create FS::cust_pay (
- 'invnum' => $invnum,
- 'paid' => $paid,
- '_date' => $_date,
- 'payby' => $payby,
- 'payinfo' => $payinfo,
- 'paybatch' => $paybatch,
-);
-
-my $error=$payment->insert;
-if ( $error ) {
- #process error
-}
-
-# end loop
-</pre>
-All fields except paybatch are contained in the cust_pay_batch table. You can use paybatch field to track particular batches and/or particular transactions within a batch.
- </ul>
-</body>
+++ /dev/null
-<head>
- <title>Configuration files</title>
-</head>
-<body>
- <h1>Configuration files</h1>
-Configuration files and directories are located in `/var/spool/freeside/conf'.
-<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'.
- <li>cybercash2 - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required.
- <li>cybercash3.2 - <a href="http://www.cybercash.com/cybercash/services/technology.html">CyberCash v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly' or `mauthcapture'). CCMckLib3_2.pm, CCMckDirectLib3_2.pm and CCMckErrno3_2 are required.
- <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>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'.
- <li>radiusmachines - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'.
- <li>registries - Directory which contains domain registry information. Each registry is a directory.
- <ul>
- <li>registries/internic - Currently the only supported registry
- <ul>
- <li>registries/internic/from - Email address from which InterNIC domain registrations are sent.
- <li>regestries/internic/nameservers - The nameservers for InterNIC domain registrations, one per line. Each line contains an IP address and hostname, separated by whitespace.
- <li>registries/internic/tech_contact - Technical contact NIC handle for domain registrations.
- <li>registries/internic/template - Template for InterNIC domain registrations with special markup. A suitable copy of the InterNIC domain template v4.0 is in `fs-x.y.z/etc/domain-template.txt'.
- <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.
- <li>shells - Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq' initially so that importing doesn't fail with `Illegal shell' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.
- <li>smtpmachine - SMTP relay for Freeside's outgoing mail.
-</ul>
-</body>
-
+++ /dev/null
-<head>
- <title>File exporting</title>
-</head>
-<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.
- <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.
- </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.
- </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.
- <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.
- </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.
- <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.
- </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>
- <ul>
- <li>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.nyc.ny.us/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, you need to use a blank passphrase.
- <li>Append the newly-created identity.pub file to root's authorized_keys on the remote machine(s).
- </ul>
-
-</body>
-
+++ /dev/null
-<head>
- <title>Documentation</title>
-</head>
-<body>
- <h1>Documentation</h1>
-<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="config.html">Configuration files</a>
-<!--
- <li><a href="admin.html">Administration</a>
-!-->
- <li><a href="../index.html#admin">Administration</a>
- <li><a href="legacy.html">Importing legacy data</a>
- <li><a href="export.html">File exporting and remote setup</a>
- <li><a href="passwd.html">fs_passwd</a>
- <li><a href="billing.html">Billing</a>
- <li><a href="trouble.html">Troubleshooting</a>
- <li><a href="schema.html">Schema reference</a>
- <li><a href="man/">Perl API</a>
-</ul>
-</body>
+++ /dev/null
-<head>
- <title>Installation</title>
-</head>
-<body>
-<h1>Installation</h1>
-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>Perl modules
- <ul>
- <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/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>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Time/">TimeDate</a>
- <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/DBI/">DBI
- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a>
- </ul>
-</ul>
-Install the Freeside distribution:
-<ul>
- <li>Add the user `freeside' to your system.
- <li>Add the freeside database to your database engine. (with <a href="http://www.mysql.com/Manual_chapter/manual_Syntax.html#Create database">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/manage-ag.htm#AEN854">PostgreSQL</a>)
- <li>Allow the freeside user full access to the freeside database. (with <a href="http://www.mysql.com/Manual_chapter/manual_Privilege_system.html#Privilege system">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/newuser.htm">PostgreSQL</a>)
- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>
- <li>Copy or link fs-x.y.z/site_perl to FS in your site_perl directory. (try `<code>perl -V</code>' if unsure) <pre>mkdir /usr/local/lib/site_perl/FS
-cp fs-x.y.z/site_perl/* /usr/local/lib/site_perl/FS</pre> or <pre>ln -s /full/path/to/fs-x.y.z/site_perl /usr/local/lib/site_perl/FS</pre>
- <li>Copy or link fs-x.y.z/htdocs to your web server's document space. <pre>mkdir /usr/local/apache/htdocs/freeside
-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.
-<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.
-</ul>
-</body>
+++ /dev/null
-<head>
- <title>Importing legacy data</title>
-</head>
-<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:
- <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)
- <li>Some accounts might have entries in users only (Port-Limit 1)
- <li>Some accounts might have entries in users only (Port-Limit >= 2)
- <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:
- <ul>
- <li>Domain (table svc_acct)
- <li>Mail alias (table svc_acct_sm)
- </ul>
- <li><a name="cust_main">Importing customer data</a>
- <ul>
- <li>Manually
- <ul>
- <li>Add a <a href="../edit/cust_main.cgi">new customer</a>
- <li>Add one or more packages for this customer
- <li>Enter a package by clicking on the package number
- <li>Pick the `Link to existing' option
- </ul>
- <li>Batch - You will need to write a script to import your particular legacy data. You can use eg/TEMPLATE_cust_main.import as a starting point.
- </ul>
-</ul>
-</body>
-
+++ /dev/null
-NAME
- FS::Bill - Legacy stub
-
-SYNOPSIS
- The functionality of FS::Bill has been integrated into
- FS::cust_main.
-
-HISTORY
- ivan@voicenet.com 97-jul-24 - 25 - 28
-
- use Safe; evaluate all fees with perl (still on TODO list until
- I write some examples & test opmask to see if we can read db)
- %hash=$obj->hash later ivan@sisd.com 98-mar-13
-
- packages with no next bill date start at $time not time, this
- should eliminate the last of the problems with billing at a past
- date also rewrite the invoice priting logic not to print
- invoices for things that haven't happended yet and update
- $cust_bill->printed when we print so PAST DUE notices work, and
- s/date/_date/ ivan@sisd.com 98-jun-4
-
- more logic for past due stuff - packages with no next bill date
- start at $cust_pkg->setup || $time ivan@sisd.com 98-jul-13
-
- moved a few things in collection logic; negative charges should
- work ivan@sisd.com 98-aug-6
-
- pod, moved everything to FS::cust_main ivan@sisd.com 98-sep-19
-
+++ /dev/null
-NAME
- FS::CGI - Subroutines for the web interface
-
-SYNOPSIS
- use FS::CGI qw(header menubar idiot eidiot);
-
- print header( 'Title', '' );
- print header( 'Title', menubar('item', 'URL', ... ) );
-
- idiot "error message";
- eidiot "error message";
-
-DESCRIPTION
- Provides a few common subroutines for the web interface.
-
-SUBROUTINES
- header TITLE, MENUBAR
- Returns an HTML header.
-
- menubar ITEM, URL, ...
- Returns an HTML menubar.
-
- idiot ERROR
- Sends headers and an HTML error message.
-
- eidiot ERROR
- Sends headers and an HTML error message, then exits.
-
-BUGS
- Not OO.
-
- Not complete.
-
- Uses CGI-modules instead of CGI.pm
-
-SEE ALSO
- the CGI::Base manpage
-
-HISTORY
- subroutines for the HTML/CGI GUI, not properly OO. :(
-
- ivan@sisd.com 98-apr-16 ivan@sisd.com 98-jun-22
-
- lose the background, eidiot ivan@sisd.com 98-sep-2
-
- pod ivan@sisd.com 98-sep-12
-
+++ /dev/null
-NAME
- FS::Conf - Read access to Freeside configuration values
-
-SYNOPSIS
- use FS::Conf;
-
- $conf = new FS::Conf;
- $conf = new FS::Conf "/non/standard/config/directory";
-
- $dir = $conf->dir;
-
- $value = $conf->config('key');
- @list = $conf->config('key');
- $bool = $conf->exists('key');
-
-DESCRIPTION
- Read access to Freeside configuration values. Keys currently map
- to filenames, but this may change in the future.
-
-METHODS
- new [ DIRECTORY ]
- Create a new configuration object. Optionally, a non-default
- directory may be specified.
-
- dir Returns the directory.
-
- config
- Returns the configuration value or values (depending on
- context) for key.
-
- exists
- Returns true if the specified key exists, even if the
- 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
- config.html from the base documentation contains a list of
- configuration files.
-
-HISTORY
- Ivan Kohler <ivan@sisd.com> 98-sep-6
-
+++ /dev/null
-NAME
- FS::Invoice - Legacy stub
-
-SYNOPSIS
- The functioanlity of FS::invoice has been integrated in
- FS::cust_bill.
-
-HISTORY
- ivan@voicenet.com 97-jun-25 - 27
-
- maybe should be changed to be OO-functions on $cust_bill
- objects? (instead of passing invnum, ugh).
-
- ISA cust_bill and return inovice instead of passing filehandle
- ivan@sisd.com 98-mar-13 (add postscript output!)
-
- close our kid when we're done ivan@sisd.com 98-jun-4
-
- separated code which shuffled data from code which formatted.
- (so i could) fixed past due notices showing up when balance due
- =< 0 return address comes from /var/spool/freeside/conf/address
- ivan@sisd.com 98-jul-2
-
+++ /dev/null
-NAME
- FS::Record - Database record objects
-
-SYNOPSIS
- use FS::Record;
- use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
-
- $record = new FS::Record 'table', \%hash;
- $record = new FS::Record 'table', { 'column' => 'value', ... };
-
- $record = qsearchs FS::Record 'table', \%hash;
- $record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
- @records = qsearch FS::Record 'table', \%hash;
- @records = qsearch FS::Record 'table', { 'column' => 'value', ... };
-
- $table = $record->table;
- $dbdef_table = $record->dbdef_table;
-
- $value = $record->get('column');
- $value = $record->getfield('column');
- $value = $record->column;
-
- $record->set( 'column' => 'value' );
- $record->setfield( 'column' => 'value' );
- $record->column('value');
-
- %hash = $record->hash;
-
- $hashref = $record->hashref;
-
- $error = $record->add;
-
- $error = $record->del;
-
- $error = $new_record->rep($old_record);
-
- $value = $record->unique('column');
-
- $value = $record->ut_float('column');
- $value = $record->ut_number('column');
- $value = $record->ut_numbern('column');
- $value = $record->ut_money('column');
- $value = $record->ut_text('column');
- $value = $record->ut_textn('column');
- $value = $record->ut_alpha('column');
- $value = $record->ut_alphan('column');
- $value = $record->ut_phonen('column');
- $value = $record->ut_anythingn('column');
-
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
-
- $quoted_value = _quote($value,'table','field');
-
- #depriciated
- $fields = hfields('table');
- if ( $fields->{Field} ) { # etc.
-
- @fields = fields 'table';
-
-DESCRIPTION
- (Mostly) object-oriented interface to database records. Records
- are currently implemented on top of DBI. FS::Record is intended
- as a base class for table-specific classes to inherit from, i.e.
- FS::cust_main.
-
-METHODS
- new TABLE, HASHREF
- Creates a new record. It doesn't store it in the database,
- though. See the section on "add" 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.
-
- 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.
-
- 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.
-
- table
- Returns the table name.
-
- dbdef_table
- Returns the FS::dbdef_table object for the table.
-
- get, getfield COLUMN
- Returns the value of the column/field/key COLUMN.
-
- set, setfield COLUMN, VALUE
- Sets the value of the column/field/key COLUMN to VALUE.
- Returns VALUE.
-
- AUTLOADED METHODS
- $record->column is a synonym for $record->get('column');
-
- $record->column('value') is a synonym for $record-
- >set('column','value');
-
- hash
- Returns a list of the column/value pairs, usually for
- assigning to a new hash.
-
- To make a distinct duplicate of an FS::Record object, you
- can do:
-
- $new = new FS::Record ( $old->table, { $old->hash } );
-
- 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.
-
- del Delete this record from the database. If there is an error,
- returns the error, otherwise returns false.
-
- rep OLD_RECORD
- Replace the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- unique COLUMN
- Replaces COLUMN in record with a unique number. Called by
- the add method on primary keys and single-field unique
- columns (see the FS::dbdef_table manpage). Returns the new
- value.
-
- ut_float COLUMN
- Check/untaint floating point numeric data: 1.1, 1, 1.1e10,
- 1e10. May not be null. If there is an error, returns the
- error, otherwise returns false.
-
- ut_number COLUMN
- Check/untaint simple numeric data (whole numbers). May not
- be null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_numbern COLUMN
- Check/untaint simple numeric data (whole numbers). May be
- null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_money COLUMN
- Check/untaint monetary numbers. May be negative. Set to 0 if
- null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_text COLUMN
- Check/untaint text. Alphanumerics, spaces, and the following
- punctuation symbols are currently permitted: ! @ # $ % & ( )
- - + ; : ' " , . ? / May not be null. If there is an error,
- returns the error, otherwise returns false.
-
- ut_textn COLUMN
- Check/untaint text. Alphanumerics, spaces, and the following
- punctuation symbols are currently permitted: ! @ # $ % & ( )
- - + ; : ' " , . ? / May be null. If there is an error,
- returns the error, otherwise returns false.
-
- ut_alpha COLUMN
- Check/untaint alphanumeric strings (no spaces). May not be
- null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_alpha COLUMN
- Check/untaint alphanumeric strings (no spaces). May be null.
- If there is an error, returns the error, otherwise returns
- false.
-
- ut_phonen COLUMN
- Check/untaint phone numbers. May be null. If there is an
- error, returns the error, otherwise returns false.
-
- ut_anything COLUMN
- Untaints arbitrary data. Be careful.
-
-SUBROUTINES
- reload_dbdef([FILENAME])
- Load a database definition (see the FS::dbdef manpage),
- optionally from a non-default filename. This command is
- executed at startup unless *$FS::Record::setup_hack* is
- true. Returns a FS::dbdef object.
-
- dbdef Returns the current database definition. See the FS::dbdef
- manpage.
-
- _quote VALUE, TABLE, COLUMN
- This is an internal function used to construct SQL
- statements. It returns VALUE DBI-quoted (see the section
- on "quote" in the DBI manpage) unless VALUE is a number
- and the column type (see the dbdef_column manpage) does
- not end in `char' or `binary'.
-
- hfields TABLE
- This is depriciated. Don't use it.
-
- 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).
-
-BUGS
- This module should probably be renamed, since much of the
- functionality is of general use. It is not completely unlike
- Adapter::DBI (see below).
-
- Exported qsearch and qsearchs should be depriciated in favor
- of method calls (against an FS::Record object like the old
- search and searchs that qsearch and qsearchs were on top
- of.)
-
- The whole fields / hfields mess should be removed.
-
- The various WHERE clauses should be subroutined.
-
- table string should be depriciated in favor of
- FS::dbdef_table.
-
- No doubt we could benefit from a Tied hash. Documenting how
- exists / defined true maps to the database (and WHERE
- clauses) would also help.
-
- The ut_ methods should ask the dbdef for a default length.
-
- ut_sqltype (like ut_varchar) should all be defined
-
- A fallback check method should be provided with uses the
- dbdef.
-
- The ut_money method assumes money has two decimal digits.
-
- The Pg money kludge in the new method only strips `$'.
-
- The ut_phonen method assumes US-style phone numbers.
-
- The _quote function should probably use ut_float instead of
- a regex.
-
- All the subroutines probably should be methods, here or
- elsewhere.
-
-SEE ALSO
- the FS::dbdef manpage, the FS::UID manpage, the DBI manpage
-
- Adapter::DBI from Ch. 11 of Advanced Perl Programming by
- Sriram Srinivasan.
-
-HISTORY
- ivan@voicenet.com 97-jun-2 - 9, 19, 25, 27, 30
-
- DBI version ivan@sisd.com 97-nov-8 - 12
-
- cleaned up, added autoloaded $self->any_field calls, moved
- DBI login stuff to FS::UID ivan@sisd.com 97-nov-21-23
-
- since AUTO_INCREMENT is MySQL specific, use my own unique
- number generator (again) ivan@sisd.com 97-dec-4
-
- untaint $user in unique (web demo hack...bah) make unique
- skip multiple-field unique's from dbdef ivan@sisd.com 97-
- dec-11
-
- merge with FS::Search, which after all was just alternate
- constructors for FS::Record objects. Makes lots of things
- cleaner. :) ivan@sisd.com 97-dec-13
-
- use FS::dbdef::primary key in replace searches, hopefully
- for all practical purposes the string/number problem in SQL
- statements should be gone? (SQL bites) ivan@sisd.com 98-jan-
- 20
-
- Put all SQL statments in $statment before we $sth=$dbh-
- >prepare( them, for debugging reasons (warn $statement)
- ivan@sisd.com 98-feb-19
-
- (sigh)... use dbdef type (char, etc.) instead of a regex to
- decide what to quote in _quote (more sillines...) SQL bites.
- ivan@sisd.com 98-feb-20
-
- more friendly error messages ivan@sisd.com 98-mar-13
-
- Added import of datasrc from FS::UID to allow Pg6.3 to work
- Added code to right-trim strings read from Pg6.3 databases
- Modified 'add' to only insert fields that actually have data
- Added ut_float to handle floating point numbers (for sales
- tax). Pg6.3 does not have a "SHOW FIELDS" statement, so I
- faked it 8). bmccane@maxbaud.net 98-apr-3
-
- commented out Pg wrapper around `` Modified 'add' to only
- insert fields that actually have data '' ivan@sisd.com 98-
- apr-16
-
- dbdef usage changes ivan@sisd.com 98-jun-1
-
- sub fields now asks dbdef, not database ivan@sisd.com 98-
- jun-2
-
- added debugging method ->_dump ivan@sisd.com 98-jun-16
-
- use FS::dbdef::primary key in delete searches as well as
- replace searches (SQL still bites) ivan@sisd.com 98-jun-22
-
- sub dbdef_table ivan@sisd.com 98-jun-28
-
- removed Pg wrapper around `` Modified 'add' to only insert
- fields that actually have data '' ivan@sisd.com 98-jul-14
-
- sub fields croaks on errors ivan@sisd.com 98-jul-17
-
- $rc eq '0E0' doesn't mean we couldn't delete for all rdbmss
- ivan@sisd.com 98-jul-18
-
- commented out code to right-trim strings read from Pg6.3
- databases; ChopBlanks is in UID.pm ivan@sisd.com 98-aug-16
-
- added code (with Pg wrapper) to deal with Pg money fields
- ivan@sisd.com 98-aug-18
-
- added pod documentation ivan@sisd.com 98-sep-6
-
+++ /dev/null
-NAME
- FS::SSH - Subroutines to call ssh and scp
-
-SYNOPSIS
- use FS::SSH qw(ssh scp issh iscp sshopen2 sshopen3);
-
- ssh($host, $command);
-
- issh($host, $command);
-
- scp($source, $destination);
-
- iscp($source, $destination);
-
- sshopen2($host, $reader, $writer, $command);
-
- sshopen3($host, $reader, $writer, $error, $command);
-
-DESCRIPTION
- Simple wrappers around ssh and scp commands.
-
-SUBROUTINES
- ssh HOST, COMMAND
- Calls ssh in batch mode.
-
- issh HOST, COMMAND
- Prints the ssh command to be executed, waits for the user to
- confirm, and (optionally) executes the command.
-
- scp SOURCE, DESTINATION
- Calls scp in batch mode.
-
- iscp SOURCE, DESTINATION
- Prints the scp command to be executed, waits for the user to
- confirm, and (optionally) executes the command.
-
- sshopen2 HOST, READER, WRITER, COMMAND
- Connects the supplied filehandles to the ssh process (in
- batch mode).
-
- sshopen3 HOST, WRITER, READER, ERROR, COMMAND
- Connects the supplied filehandles to the ssh process (in
- batch mode).
-
-BUGS
- Not OO.
-
- scp stuff should transparantly use rsync-over-ssh instead.
-
-SEE ALSO
- the ssh manpage, the scp manpage, the IPC::Open2 manpage,
- the IPC::Open3 manpage
-
-HISTORY
- ivan@voicenet.com 97-jul-17
-
- added sshopen2 and sshopen3 ivan@sisd.com 98-mar-9
-
- added iscp ivan@sisd.com 98-jul-25 now iscp asks y/n, issh
- and took out path ivan@sisd.com 98-jul-30
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::UID - Subroutines for database login and assorted other
- stuff
-
-SYNOPSIS
- use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
- checkeuid checkruid swapuid);
-
- adminsuidsetup;
-
- $cgi = new CGI::Base;
- $cgi->get;
- $dbh = cgisuidsetup($cgi);
-
- $dbh = dbh;
-
- $datasrc = datasrc;
-
-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
- database handle (usually you don't need this).
-
- 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'.
-
- checkeuid
- Returns true if effective UID is that of the freeside user.
-
- checkruid
- Returns true if the real UID is that of the freeside user.
-
- swapuid
- Swaps real and effective UIDs.
-
-BUGS
- Not OO.
-
- No capabilities yet. When mod_perl and Authen::DBI are
- implemented, cgisuidsetup will go away as well.
-
-SEE ALSO
- the FS::Record manpage, the CGI::Base manpage, the DBI manpage
-
-HISTORY
- ivan@voicenet.com 97-jun-4 - 9 untaint otaker ivan@voicenet.com
- 97-jul-7
-
- generalize and auto-get uid (getotaker still needs to be db'ed)
- ivan@sisd.com 97-nov-10
-
- &cgisuidsetup logs into database. other cleaning. ivan@sisd.com
- 97-nov-22,23
-
- &adminsuidsetup logs into database with otaker='freeside' (for
- automated tasks like billing) ivan@sisd.com 97-dec-13
-
- added sub datasrc for fs-setup ivan@sisd.com 98-feb-21
-
- datasrc, user and pass now come from conf/secrets ivan@sisd.com
- 98-jun-28
-
- added ChopBlanks to DBI call (see man DBI) ivan@sisd.com 98-aug-
- 16
-
- pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
- inlined suidsetup ivan@sisd.com 98-sep-12
-
+++ /dev/null
-NAME
- FS::agent - Object methods for agent records
-
-SYNOPSIS
- use FS::agent;
-
- $record = create FS::agent \%hash;
- $record = create FS::agent { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::agent object represents an agent. Every customer has an
- agent. Agents can be used to track things like resellers or
- salespeople. FS::agent inherits from FS::Record. The following
- fields are currently supported:
-
- agemtnum - primary key (assigned automatically for new agents)
- agent - Text name of this agent
- typenum - Agent type. See the FS::agent_type manpage
- prog - For future use.
- freq - For future use.
-METHODS
- create HASHREF
- Creates a new agent. To add the agent to the database, see
- the section on "insert".
-
- insert
- Adds this agent to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this agent from the database. Only agents with no
- customers can be deleted. If there is an error, returns the
- error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces 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 agent. 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.
-
-SEE ALSO
- the FS::Record manpage, the FS::agent_type manpage, the
- FS::cust_main manpage, schema.html from the base documentation.
-
-HISTORY
- Class dealing with agent (resellers)
-
- ivan@sisd.com 97-nov-13, 97-dec-10
-
- pod, added check in ->delete ivan@sisd.com 98-sep-22
-
+++ /dev/null
-NAME
- FS::agent_type - Object methods for agent_type records
-
-SYNOPSIS
- use FS::agent_type;
-
- $record = create FS::agent_type \%hash;
- $record = create FS::agent_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::agent_type object represents an agent type. Every agent
- (see the FS::agent manpage) has an agent type. Agent types
- define which packages (see the FS::part_pkg manpage) may be
- purchased by customers (see the FS::cust_main manpage), via
- FS::type_pkgs records (see the FS::type_pkgs manpage).
- FS::agent_type inherits from FS::Record. The following fields
- are currently supported:
-
- typenum - primary key (assigned automatically for new agent types)
- atype - Text name of this agent type
-METHODS
- create HASHREF
- Creates a new agent type. To add the agent type to the
- database, see the section on "insert".
-
- insert
- Adds this agent type to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this agent type from the database. Only agent types
- with no agents can be deleted. If there is an error, returns
- the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces 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 agent type.
- 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.
-
-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,
- schema.html from the base documentation.
-
-HISTORY
- Class for the different sets of allowable packages you can
- assign to an agent.
-
- ivan@sisd.com 97-nov-13
-
- ut_ FS::Record methods ivan@sisd.com 97-dec-10
-
- Changed 'type' to 'atype' because Pg6.3 reserves the type word
- bmccane@maxbaud.net 98-apr-3
-
- pod, added check in delete ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_bill - Object methods for cust_bill records
-
-SYNOPSIS
- use FS::cust_bill;
-
- $record = create FS::cust_bill \%hash;
- $record = create FS::cust_bill { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
-
- @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
-
- ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
-
- @cust_pay_objects = $cust_bill->cust_pay;
-
- @lines = $cust_bill->print_text;
- @lines = $cust_bill->print_text $time;
-
-DESCRIPTION
- An FS::cust_bill object represents an invoice. FS::cust_bill
- inherits from FS::Record. The following fields are currently
- supported:
-
- invnum - primary key (assigned automatically for new invoices)
- custnum - customer (see the FS::cust_main manpage)
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- charged - amount of this invoice
- owed - amount still outstanding on this invoice, which is charged minus
- all payments (see the FS::cust_pay manpage).
- printed - how many times this invoice has been printed automatically
- (see the section on "collect" in the FS::cust_main manpage).
-METHODS
- create 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
- FS::cust_main manpage).
-
- insert
- Adds this invoice to the database ("Posts" the invoice). If
- there is an error, returns the error, otherwise returns
- false.
-
- When adding new invoices, owed must be charged (or null, in
- which case it is automatically set to charged).
-
- delete
- Currently unimplemented. I don't remove invoices because
- there would then be no record you ever posted this invoice
- (which is bad, no?)
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- Only owed and printed may be changed. Owed is normally
- updated by creating and inserting a payment (see the
- FS::cust_pay manpage). Printed is normally updated by
- calling the collect method of a customer object (see the
- FS::cust_main manpage).
-
- check
- Checks all fields to make sure this is a valid invoice. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- previous
- Returns a list consisting of the total previous balance for
- this customer, followed by the previous outstanding invoices
- (as FS::cust_bill objects also).
-
- cust_bill_pkg
- Returns the line items (see the FS::cust_bill_pkg manpage)
- for this invoice.
-
- cust_credit
- Returns a list consisting of the total previous credited
- (see the FS::cust_credit manpage) for this customer,
- followed by the previous outstanding credits
- (FS::cust_credit objects).
-
- cust_pay
- Returns all payments (see the FS::cust_pay manpage) for this
- invoice.
-
- print_text [TIME];
- Returns an ASCII invoice, as a list of lines.
-
- TIME an optional value used to control the printing of
- overdue messages. The default is now. It isn't the date of
- the invoice; that's the `_date' field. It is specified as a
- UNIX timestamp; see the section on "time" in the perlfunc
- manpage. Also see the Time::Local manpage and the
- Date::Parse manpage for conversion functions.
-
-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 ($=).
-
- 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
- FS::cust_credit manpage, schema.html from the base
- documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-1
-
- small fix for new API ivan@sisd.com 98-mar-14
-
- charges can be negative ivan@sisd.com 98-jul-13
-
- pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
-
+++ /dev/null
-NAME
- FS::cust_bill_pkg - Object methods for cust_bill_pkg records
-
-SYNOPSIS
- use FS::cust_bill_pkg;
-
- $record = create FS::cust_bill_pkg \%hash;
- $record = create FS::cust_bill_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_bill_pkg object represents an invoice line item.
- FS::cust_bill_pkg inherits from FS::Record. The following fields
- are currently supported:
-
- invnum - invoice (see the FS::cust_bill manpage)
- pkgnum - package (see the FS::cust_pkg manpage)
- setup - setup fee
- recur - recurring fee
- sdate - starting date of recurring fee
- edate - ending date of recurring fee
- sdate and edate are specified as UNIX timestamps; see the
- section on "time" in the perlfunc manpage. Also see the
- Time::Local manpage and the Date::Parse manpage for conversion
- functions.
-
-METHODS
- create 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
- object (see the FS::cust_main manpage).
-
- insert
- Adds this line item to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Currently unimplemented. I don't remove line items because
- there would then be no record the items ever existed (which
- is bad, no?)
-
- replace OLD_RECORD
- Currently unimplemented. This would be even more of an
- accounting nightmare than deleteing the items. Just don't do
- it.
-
- check
- Checks all fields to make sure this is a valid line item. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert method.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_bill manpage, the
- FS::cust_pkg manpage, the FS::cust_main manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@sisd.com 98-mar-13
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_credit - Object methods for cust_credit records
-
-SYNOPSIS
- use FS::cust_credit;
-
- $record = create FS::cust_credit \%hash;
- $record = create FS::cust_credit { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_credit object represents a credit. FS::cust_credit
- inherits from FS::Record. The following fields are currently
- supported:
-
- crednum - primary key (assigned automatically for new credits)
- custnum - customer (see the FS::cust_main manpage)
- amount - amount of the credit
- credited - how much of this credit that is still outstanding, which is
- amount minus all refunds (see the FS::cust_refund manpage).
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- otaker - order taker (assigned automatically, see the FS::UID manpage)
- reason - text
-METHODS
- create HASHREF
- Creates a new credit. To add the credit to the database, see
- the section on "insert".
-
- insert
- Adds this credit to the database ("Posts" the credit). If
- there is an error, returns the error, otherwise returns
- false.
-
- When adding new invoices, credited must be amount (or null,
- in which case it is automatically set to amount).
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- Only credited may be changed. Credited is normally updated
- by creating and inserting a refund (see the FS::cust_refund
- manpage).
-
- check
- Checks all fields to make sure this is a valid credit. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-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.
-
-HISTORY
- ivan@sisd.com 98-mar-17
-
- pod, otaker from FS::UID ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_main - Object methods for cust_main records
-
-SYNOPSIS
- use FS::cust_main;
-
- $record = create FS::cust_main \%hash;
- $record = create FS::cust_main { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- @cust_pkg = $record->all_pkgs;
-
- @cust_pkg = $record->ncancelled_pkgs;
-
- $error = $record->bill;
- $error = $record->bill %options;
- $error = $record->bill 'time' => $time;
-
- $error = $record->collect;
- $error = $record->collect %options;
- $error = $record->collect 'invoice_time' => $time,
- 'batch_card' => 'yes',
- 'report_badcard' => 'yes',
- ;
-
-DESCRIPTION
- An FS::cust_main object represents a customer. FS::cust_main
- inherits from FS::Record. The following fields are currently
- supported:
-
- custnum - primary key (assigned automatically for new customers)
- agentnum - agent (see the FS::agent manpage)
- refnum - referral (see the FS::part_referral manpage)
- first - name
- last - name
- ss - social security number (optional)
- company - (optional)
- address1
- address2 - (optional)
- city
- county - (optional, see the FS::cust_main_county manpage)
- state - (see the FS::cust_main_county manpage)
- zip
- country - (see the FS::cust_main_county manpage)
- daytime - phone (optional)
- night - phone (optional)
- payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
- payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
- paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
- payname - name on card or billing name
- tax - tax exempt, empty or `Y'
- otaker - order taker (assigned automatically, see the FS::UID manpage)
-METHODS
- create HASHREF
- Creates a new customer. To add the customer 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 customer to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Currently unimplemented. Maybe cancel all of this customer's
- packages (cust_pkg)?
-
- I don't remove the customer record in the database because
- there would then be no record the customer ever existed
- (which is bad, no?)
-
- 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 customer
- record. If there is an error, returns the error, otherwise
- returns false. Called by the insert and repalce methods.
-
- all_pkgs
- Returns all packages (see the FS::cust_pkg manpage) for this
- customer.
-
- ncancelled_pkgs
- Returns all non-cancelled packages (see the FS::cust_pkg
- manpage) for this customer.
-
- bill OPTIONS
- Generates invoices (see the FS::cust_bill manpage) for this
- customer. Usually used in conjunction with the collect
- method.
-
- The only currently available option is `time', which bills
- the customer as if it were that time. It is specified as a
- UNIX timestamp; see the section on "time" in the perlfunc
- manpage). Also see the Time::Local manpage and the
- Date::Parse manpage for conversion functions.
-
- If there is an error, returns the error, otherwise returns
- false.
-
- collect OPTIONS
- (Attempt to) collect money for this customer's outstanding
- invoices (see the FS::cust_bill manpage). Usually used after
- the bill method.
-
- Depending on the value of `payby', this may print an invoice
- (`BILL'), charge a credit card (`CARD'), or just add any
- necessary (pseudo-)payment (`COMP').
-
- If there is an error, returns the error, otherwise returns
- false.
-
- Currently available options are:
-
- invoice_time - Use this time when deciding when to print
- invoices and late notices on those invoices. The default is
- now. It is specified as a UNIX timestamp; see the section on
- "time" in the perlfunc manpage). Also see the Time::Local
- manpage and the Date::Parse manpage for conversion
- functions.
-
- batch_card - Set this true to batch cards (see the
- cust_pay_batch manpage). By default, cards are processed
- immediately, which will generate an error if CyberCash is
- not installed.
-
- report_badcard - Set this true if you want bad card
- transactions to return an error. By default, they don't.
-
- total_owed
- Returns the total owed for this customer on all invoices
- (see the FS::cust_bill manpage).
-
- total_credited
- Returns the total credits (see the FS::cust_credit manpage)
- for this customer.
-
- balance
- Returns the balance for this customer (total owed minus
- total credited).
-
-BUGS
- The delete method.
-
- It doesn't properly override FS::Record yet.
-
- hfields should be removed.
-
- 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.
-
-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.
-
-HISTORY
- ivan@voicenet.com 97-jul-28
-
- Changed to standard Business::CreditCard no more TableUtil
- EXPORT_OK FS::Record's hfields removed unique calls and locking
- (not needed here now) wrapped the (now) optional fields in if
- statements in sub check (notyetdone!) ivan@sisd.com 97-nov-12
-
- updated paydate with SQL-type date info ivan@sisd.com 98-mar-5
-
- Added export of datasrc from UID.pm for Pg6.3 changed 'day' to
- 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
- in ->create, s/svc_acct/cust_main/, now it should actually
- eliminate the warnings it was meant to ivan@sisd.com 98-jul-16
-
- don't require a phone number and allow '/' in company names
- ivan@sisd.com 98-jul-18
-
- use ut_ and rewrite &check, &*_pkgs ivan@sisd.com 98-sep-5
-
- pod, merge with FS::Bill (about time!), total_owed,
- total_credited and balance methods, cleaned collect method,
- source modifications no longer necessary to enable cybercash,
- cybercash v3 support, don't need to import
- FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
-
+++ /dev/null
-NAME
- FS::cust_main_county - Object methods for cust_main_county
- objects
-
-SYNOPSIS
- use FS::cust_main_county;
-
- $record = create FS::cust_main_county \%hash;
- $record = create FS::cust_main_county { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_main_county object represents a tax rate, defined by
- locale. FS::cust_main_county inherits from FS::Record. The
- following fields are currently supported:
-
- taxnum - primary key (assigned automatically for new tax rates)
- state
- county
- tax - percentage
-METHODS
- create HASHREF
- Creates a new tax rate. To add the tax rate to the database,
- see the section on "insert".
-
- insert
- Adds this tax rate to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this tax rate from the database. If there is an
- error, returns the error, otherwise returns false.
-
- 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 tax rate. 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.
-
- A country field (and possibly a currency field) should be added.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_main manpage, the
- FS::cust_bill manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-dec-16
-
- Changed check for 'tax' to use the new ut_float subroutine
- bmccane@maxbaud.net 98-apr-3
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_pay - Object methods for cust_pay objects
-
-SYNOPSIS
- use FS::cust_pay;
-
- $record = create FS::cust_pay \%hash;
- $record = create FS::cust_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_pay object represents a payment. FS::cust_pay
- inherits from FS::Record. The following fields are currently
- supported:
-
- paynum - primary key (assigned automatically for new payments)
- invnum - Invoice (see the FS::cust_bill manpage)
- paid - Amount of this payment
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
- payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
- paybatch - text field for tracking card processing
-METHODS
- create HASHREF
- Creates a new payment. To add the payment to the databse,
- see the section on "insert".
-
- insert
- Adds this payment to the databse, and updates the invoice
- (see the FS::cust_bill manpage).
-
- delete
- Currently unimplemented (accounting reasons).
-
- replace OLD_RECORD
- Currently unimplemented (accounting reasons).
-
- check
- Checks all fields to make sure this is a valid payment. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert method.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- Delete and replace methods.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_bill manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-1 - 25 - 29
-
- new api ivan@sisd.com 98-mar-13
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_pkg - Object methods for cust_pkg objects
-
-SYNOPSIS
- use FS::cust_pkg;
-
- $record = create FS::cust_pkg \%hash;
- $record = create FS::cust_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->cancel;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = FS::cust_pkg::order( $custnum, \@pkgparts );
- $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
-
-DESCRIPTION
- An FS::cust_pkg object represents a customer billing item.
- FS::cust_pkg inherits from FS::Record. The following fields are
- currently supported:
-
- pkgnum - primary key (assigned automatically for new billing items)
- custnum - Customer (see the FS::cust_main manpage)
- pkgpart - Billing item definition (see the FS::part_pkg manpage)
- setup - date
- bill - date
- susp - date
- expire - date
- cancel - date
- otaker - order taker (assigned automatically if null, see the FS::UID manpage)
- Note: setup, bill, susp, expire and cancel are specified as UNIX
- timestamps; see the section on "time" in the perlfunc manpage.
- Also see the Time::Local manpage and the Date::Parse manpage for
- conversion functions.
-
-METHODS
- create HASHREF
- Create a new billing item. To add the item to the database,
- see the section on "insert".
-
- insert
- Adds this billing item to the database ("Orders" the item).
- If there is an error, returns the error, otherwise returns
- false.
-
- 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
- false.
-
- Currently, custnum, setup, bill, susp, expire, and cancel
- may be changed.
-
- pkgpart may not be changed, but 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).
-
- suspend is normally updated by the suspend and unsuspend
- methods.
-
- cancel is normally updated by the cancel method (and also
- the order subroutine in some cases).
-
- check
- Checks all fields to make sure this is a valid billing item.
- If there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- cancel
- Cancels and removes all services (see the FS::cust_svc
- manpage and the FS::part_svc manpage) in this package, then
- cancels the package itself (sets the cancel field to now).
-
- If there is an error, returns the error, otherwise returns
- false.
-
- suspend
- Suspends all services (see the FS::cust_svc manpage and the
- FS::part_svc manpage) in this package, then suspends the
- package itself (sets the susp field to now).
-
- If there is an error, returns the error, otherwise returns
- false.
-
- unsuspend
- Unsuspends all services (see the FS::cust_svc manpage and
- the FS::part_svc manpage) in this package, then unsuspends
- the package itself (clears the susp field).
-
- If there is an error, returns the error, otherwise returns
- false.
-
-SUBROUTINES
- order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
- CUSTNUM is a customer (see the FS::cust_main manpage)
-
- PKGPARTS is a list of pkgparts specifying the the billing
- item definitions (see the FS::part_pkg manpage) to order for
- this customer. Duplicates are of course permitted.
-
- REMOVE_PKGNUMS is an optional list of pkgnums specifying the
- billing items to remove for this customer. The services (see
- the FS::cust_svc manpage) are moved to the new billing
- 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.
-
- sub order is not OO. Perhaps it should be moved to FS::cust_main
- and made so?
-
- In sub order, the @pkgparts array (passed by reference) is
- clobbered.
-
- Also in sub order, no money is adjusted. Once FS::part_pkg
- defines a standard method to pass dates to the recur_prog
- expression, it should do so.
-
-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
- manpage, schema.html from the base documentation
-
-HISTORY
- ivan@voicenet.com 97-jul-1 - 21
-
- fixed for new agent->agent_type->type_pkgs in &order
- ivan@sisd.com 98-mar-7
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_refund - Object method for cust_refund objects
-
-SYNOPSIS
- use FS::cust_refund;
-
- $record = create FS::cust_refund \%hash;
- $record = create FS::cust_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_refund represents a refund. FS::cust_refund inherits
- from FS::Record. The following fields are currently supported:
-
- refundnum - primary key (assigned automatically for new refunds)
- crednum - Credit (see the FS::cust_credit manpage)
- refund - Amount of the refund
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
- 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
- Creates a new refund. To add the refund to the database, see
- the section on "insert".
-
- insert
- Adds this refund to the database, and updates the credit
- (see the FS::cust_credit manpage).
-
- delete
- Currently unimplemented (accounting reasons).
-
- replace OLD_RECORD
- Currently unimplemented (accounting reasons).
-
- check
- Checks all fields to make sure this is a valid refund. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert method.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- Delete and replace methods.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_credit manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@sisd.com 98-mar-18
-
- ->create had wrong tablename ivan@sisd.com 98-jun-16 (finish
- me!)
-
- pod and finish up ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_svc - Object method for cust_svc objects
-
-SYNOPSIS
- use FS::cust_svc;
-
- $record = create FS::cust_svc \%hash
- $record = create FS::cust_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_svc represents a service. FS::cust_svc inherits from
- FS::Record. The following fields are currently supported:
-
- svcnum - primary key (assigned automatically for new services)
- pkgnum - Package (see the FS::cust_pkg manpage)
- svcpart - Service definition (see the FS::part_svc manpage)
-METHODS
- create 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,
- the FS::svc_domain manpage, and the FS::svc_acct_sm manpage,
- among others).
-
- insert
- Adds this service to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this service from the database. If there is an
- error, returns the error, otherwise returns false.
-
- Called by the cancel method of the package (see the
- FS::cust_pkg manpage).
-
- 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 service. If
- there is an error, returns the error, otehrwise returns
- false. Called by the insert and replace methods.
-
-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).
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_pkg manpage, the
- FS::part_svc manpage, the FS::pkg_svc manpage, schema.html from
- the base documentation
-
-HISTORY
- ivan@voicenet.com 97-jul-10,14
-
- no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::dbdef - Database objects
-
-SYNOPSIS
- use FS::dbdef;
-
- $dbdef = new FS::dbdef (@dbdef_table_objects);
- $dbdef = load FS::dbdef "filename";
-
- $dbdef->save("filename");
-
- $dbdef->addtable($dbdef_table_object);
-
- @table_names = $dbdef->tables;
-
- $FS_dbdef_table_object = $dbdef->table;
-
-DESCRIPTION
- FS::dbdef objects are collections of FS::dbdef_table objects and
- represnt a database (a collection of tables).
-
-METHODS
- new TABLE, TABLE, ...
- Creates a new FS::dbdef object
-
- load FILENAME
- Loads an FS::dbdef object from a file.
-
- save FILENAME
- Saves an FS::dbdef object to a file.
-
- addtable TABLE
- Adds this FS::dbdef_table object.
-
- tables
- Returns the names of all tables.
-
- table TABLENAME
- Returns the named FS::dbdef_table object.
-
-BUGS
- Each FS::dbdef object should have a name which corresponds
- to its name within the SQL database engine.
-
-SEE ALSO
- the FS::dbdef_table manpage, the FS::Record manpage,
-
-HISTORY
- beginning of abstraction into a class (not really)
-
- ivan@sisd.com 97-dec-4
-
- added primary_key ivan@sisd.com 98-jan-20
-
- added datatype (very kludgy and needs to be cleaned)
- ivan@sisd.com 98-feb-21
-
- perltrap (sigh) masked by mysql 3.20->3,21 ivan@sisd.com 98-
- mar-2
-
- Change 'type' to 'atype' in agent_type Changed attributes to
- special words which are changed in fs-setup ie. double(10,2)
- <=> MONEYTYPE Changed order of some of the field definitions
- because Pg6.3 is picky Changed 'day' to 'daytime' in
- cust_main Changed type of tax from tinyint to real Change
- 'password' to '_password' in svc_acct Pg6.3 does not allow
- 'field char(x) NULL' bmccane@maxbaud.net 98-apr-3
-
- rewrite: now properly OO. See also
- FS::dbdef_{table,column,unique,index}
-
- ivan@sisd.com 98-apr-17
-
- gained some extra functions ivan@sisd.com 98-may-11
-
- now knows how to Freeze and Thaw itself ivan@sisd.com 98-
- jun-2
-
- pod ivan@sisd.com 98-sep-23
-
+++ /dev/null
-NAME
- FS::dbdef_colgroup - Column group objects
-
-SYNOPSIS
- use FS::dbdef_colgroup;
-
- $colgroup = new FS::dbdef_colgroup ( $lol );
- $colgroup = new FS::dbdef_colgroup (
- [
- [ 'single_column' ],
- [ 'multiple_columns', 'another_column', ],
- ]
- );
-
- @sql_lists = $colgroup->sql_list;
-
- @singles = $colgroup->singles;
-
-DESCRIPTION
- FS::dbdef_colgroup objects represent sets of sets of columns.
-
-METHODS
- new Creates a new FS::dbdef_colgroup object.
-
- sql_list
- Returns a flat list of comma-separated values, for SQL
- statements.
-
- singles
- Returns a flat list of all single item lists.
-
-BUGS
-SEE ALSO
- the FS::dbdef_table manpage, the FS::dbdef_unique manpage, the
- FS::dbdef_index manpage, the FS::dbdef_column manpage, the
- FS::dbdef manpage, the perldsc manpage
-
-HISTORY
- class for dealing with groups of groups of columns (used as a
- base class by FS::dbdef_{unique,index} )
-
- ivan@sisd.com 98-apr-19
-
- added singles, fixed sql_list to skip empty lists ivan@sisd.com
- 98-jun-2
-
- untaint things we're returning in sub singels ivan@sisd.com 98-
- jun-4
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-NAME
- FS::dbdef_column - Column object
-
-SYNOPSIS
- use FS::dbdef_column;
-
- $column_object = new FS::dbdef_column ( $name, $sql_type, '' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, '', $length );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL', $length );
-
- $name = $column_object->name;
- $column_object->name ( 'name' );
-
- $name = $column_object->type;
- $column_object->name ( 'sql_type' );
-
- $name = $column_object->null;
- $column_object->name ( 'NOT NULL' );
-
- $name = $column_object->length;
- $column_object->name ( $length );
-
- $sql_line = $column->line;
- $sql_line = $column->line $datasrc;
-
-DESCRIPTION
- FS::dbdef::column objects represend columns in tables (see the
- FS::dbdef_table manpage).
-
-METHODS
- new Creates a new FS::dbdef_column object.
-
- name
- Returns or sets the column name.
-
- type
- Returns or sets the column type.
-
- null
- Returns or sets the column null flag.
-
- type
- Returns or sets the column length.
-
- 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.
-
-BUGS
-SEE ALSO
- the FS::dbdef_table manpage, the FS::dbdef manpage, the DBI
- manpage
-
-HISTORY
- class for dealing with column definitions
-
- ivan@sisd.com 98-apr-17
-
- now methods can be used to get or set data ivan@sisd.com 98-may-
- 11
-
- mySQL-specific hack for null (what should be default?)
- ivan@sisd.com 98-jun-2
-
+++ /dev/null
-NAME
- FS::dbdef_unique.pm - Index object
-
-SYNOPSIS
- use FS::dbdef_index;
-
- # see FS::dbdef_colgroup methods
-
-DESCRIPTION
- FS::dbdef_unique objects represent the (non-unique) indices of a
- table (the FS::dbdef_table manpage). FS::dbdef_unique inherits
- from FS::dbdef_colgroup.
-
-BUGS
- Is this empty subclass needed?
-
-SEE ALSO
- the FS::dbdef_colgroup manpage, the FS::dbdef_record manpage,
- the FS::Record manpage
-
-HISTORY
- class for dealing with index definitions
-
- ivan@sisd.com 98-apr-19
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-NAME
- FS::dbdef_table - Table objects
-
-SYNOPSIS
- use FS::dbdef_table;
-
- $dbdef_table = new FS::dbdef_table (
- "table_name",
- "primary_key",
- $FS_dbdef_unique_object,
- $FS_dbdef_index_object,
- @FS_dbdef_column_objects,
- );
-
- $dbdef_table->addcolumn ( $FS_dbdef_column_object );
-
- $table_name = $dbdef_table->name;
- $dbdef_table->name ("table_name");
-
- $table_name = $dbdef_table->primary_keye;
- $dbdef_table->primary_key ("primary_key");
-
- $FS_dbdef_unique_object = $dbdef_table->unique;
- $dbdef_table->unique ( $FS_dbdef_unique_object );
-
- $FS_dbdef_index_object = $dbdef_table->index;
- $dbdef_table->index ( $FS_dbdef_index_object );
-
- @column_names = $dbdef->columns;
-
- $FS_dbdef_column_object = $dbdef->column;
-
- @sql_statements = $dbdef->sql_create_table;
- @sql_statements = $dbdef->sql_create_table $datasrc;
-
-DESCRIPTION
- FS::dbdef_table objects represent a single database table.
-
-METHODS
- new Creates a new FS::dbdef_table object.
-
- addcolumn
- Adds this FS::dbdef_column object.
-
- name
- Returns or sets the table name.
-
- primary_key
- Returns or sets the primary key.
-
- unique
- Returns or sets the FS::dbdef_unique object.
-
- index
- Returns or sets the FS::dbdef_index object.
-
- columns
- Returns a list consisting of the names of all columns.
-
- column "column"
- Returns the column object (see the FS::dbdef_column manpage)
- for "column".
-
- sql_create_table [ $datasrc ]
- Returns an array of SQL statments to create this table.
-
- 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.
-
-BUGS
-SEE ALSO
- the FS::dbdef manpage, the FS::dbdef_unique manpage, the
- FS::dbdef_index manpage, the FS::dbdef_unique manpage, the DBI
- manpage
-
-HISTORY
- class for dealing with table definitions
-
- ivan@sisd.com 98-apr-18
-
- gained extra functions (should %columns be an IxHash?)
- ivan@sisd.com 98-may-11
-
- sql_create_table returns a list of statments, not just one, and
- now it does indices (plus mysql hack) ivan@sisd.com 98-jun-2
-
- untaint primary_key... hmm. is this a hack around a bigger
- problem? looks like, did the same thing singles in colgroup!
- ivan@sisd.com 98-jun-4
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-NAME
- FS::dbdef_unique.pm - Unique object
-
-SYNOPSIS
- use FS::dbdef_unique;
-
- # see FS::dbdef_colgroup methods
-
-DESCRIPTION
- FS::dbdef_unique objects represent the unique indices of a
- database table (the FS::dbdef_table manpage). FS::dbdef_unique
- inherits from FS::dbdef_colgroup.
-
-BUGS
- Is this empty subclass needed?
-
-SEE ALSO
- the FS::dbdef_colgroup manpage, the FS::dbdef_record manpage,
- the FS::Record manpage
-
-HISTORY
- class for dealing with unique definitions
-
- ivan@sisd.com 98-apr-19
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-<head>
- <title>Perl API</title>
-</head>
-<body>
- <h1>Perl API</h1>
- <ul>
-<li><a href="agent.txt">FS::agent</a>
-<li><a href="agent_type.txt">FS::agent_type</a>
-<li><a href="cust_bill.txt">FS::cust_bill</a>
-<li><a href="cust_bill_pkg.txt">FS::cust_bill_pkg</a>
-<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_pay.txt">FS::cust_pay</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>
-<li><a href="part_pkg.txt">FS::part_pkg</a>
-<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_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>
-<li><a href="svc_domain.txt">FS::svc_domain</a>
-<li><a href="type_pkgs.txt">FS::type_pkgs</a>
-</ul>
-<br>
-<ul>
-<li><a href="Bill.txt">FS::Bill</a>
-<li><a href="CGI.txt">FS::CGI</a>
-<li><a href="Conf.txt">FS::Conf</a>
-<li><a href="Invoice.txt">FS::Invoice</a>
-<li><a href="Record.txt">FS::Record</a>
-<li><a href="SSH.txt">FS::SSH</a>
-<li><a href="UID.txt">FS::UID</a>
-</ul>
-<br>
-<ul>
-<li><a href="dbdef.txt">FS::dbdef</a>
-<li><a href="dbdef_colgroup.txt">FS::dbdef_colgroup</a>
-<li><a href="dbdef_column.txt">FS::dbdef_column</a>
-<li><a href="dbdef_index.txt">FS::dbdef_index</a>
-<li><a href="dbdef_table.txt">FS::dbdef_table</a>
-<li><a href="dbdef_unique.txt">FS::dbdef_unique</a>
-
-<ul>
-</body>
+++ /dev/null
-NAME
- FS::part_pkg - Object methods for part_pkg objects
-
-SYNOPSIS
- use FS::part_pkg;
-
- $record = create FS::part_pkg \%hash
- $record = create FS::part_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::part_pkg represents a billing item definition.
- FS::part_pkg inherits from FS::Record. The following fields are
- currently supported:
-
- pkgpart - primary key (assigned automatically for new billing item definitions)
- pkg - Text name of this billing item definition (customer-viewable)
- comment - Text name of this billing item definition (non-customer-viewable)
- setup - Setup fee
- freq - Frequency of recurring fee
- recur - Recurring fee
- setup and recur are evaluated as Safe perl expressions. You can
- use numbers just as you would normally. More advanced semantics
- are not yet defined.
-
-METHODS
- create HASHREF
- Creates a new billing item definition. 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.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces 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 billing item
- definition. 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.
-
- The delete method is unimplemented.
-
- setup and recur semantics are not yet defined (and are
- implemented in FS::cust_bill. hmm.).
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_pkg manpage, the
- FS::type_pkgs manpage, the FS::pkg_svc manpage, the Safe
- manpage. schema.html from the base documentation.
-
-HISTORY
- ivan@sisd.com 97-dec-5
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::part_referral - Object methods for part_referral objects
-
-SYNOPSIS
- use FS::part_referral;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::part_referral represents a referral - where a customer
- heard of your services. This can be used to track the
- effectiveness of a particular piece of advertising, for example.
- FS::part_referral inherits from FS::Record. The following fields
- are currently supported:
-
- refnum - primary key (assigned automatically for new referrals)
- referral - Text name of this referral
-METHODS
- create HASHREF
- Creates a new referral. To add the referral to the database,
- see the section on "insert".
-
- insert
- Adds this referral to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces 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 referral. 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.
-
- The delete method is unimplemented.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_main manpage, schema.html
- from the base documentation.
-
-HISTORY
- Class dealing with referrals
-
- ivan@sisd.com 98-feb-23
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::part_svc - Object methods for part_svc objects
-
-SYNOPSIS
- use FS::part_svc;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::part_svc represents a service definition. FS::part_svc
- inherits from FS::Record. The following fields are currently
- supported:
-
- svcpart - primary key (assigned automatically for new service definitions)
- svc - text name of this service definition
- svcdb - table used for this service. See the FS::svc_acct manpage,
- the FS::svc_domain manpage, and the FS::svc_acct_sm manpage, among others.
- *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
- Creates a new service definition. To add the service
- definition to the database, see the section on "insert".
-
- insert
- Adds this service definition to the database. If there is an
- error, returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces 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 service
- definition. 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.
-
- Delete is unimplemented.
-
-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
- manpage, the FS::svc_acct_sm manpage, the FS::svc_domain
- manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@sisd.com 97-nov-14
-
- data checking/untainting calls into FS::Record added
- ivan@sisd.com 97-dec-6
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::pkg_svc - Object methods for pkg_svc records
-
-SYNOPSIS
- use FS::pkg_svc;
-
- $record = create FS::pkg_svc \%hash;
- $record = create FS::pkg_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::pkg_svc record links a billing item definition (see the
- FS::part_pkg manpage) to a service definition (see the
- FS::part_svc manpage). FS::pkg_svc inherits from FS::Record. The
- following fields are currently supported:
-
- pkgpart - Billing item definition (see the FS::part_pkg manpage)
- svcpart - Service definition (see the FS::part_svc manpage)
- quantity - Quantity of this service definition that this billing item
- definition includes
-METHODS
- create HASHREF
- Create a new record. To add the record to the database, see
- the section on "insert".
-
- insert
- Adds this record to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this record from the database. If there is an error,
- returns the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces 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 record. 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.
-
-SEE ALSO
- the FS::Record manpage, the FS::part_pkg manpage, the
- FS::part_svc manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-1 added hfields ivan@sisd.com 97-nov-13
-
- pod ivan@sisd.com 98-sep-22
-
+++ /dev/null
-NAME
- FS::svc_acct - Object methods for svc_acct records
-
-SYNOPSIS
- use FS::svc_acct;
-
- $record = create FS::svc_acct \%hash;
- $record = create FS::svc_acct { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-DESCRIPTION
- An FS::svc_acct object represents an account. FS::svc_acct
- inherits from FS::Record. The following fields are currently
- supported:
-
- svcnum - primary key (assigned automatcially for new accounts)
- username
- _password - generated if blank
- popnum - Point of presence (see the FS::svc_acct_pop manpage)
- uid
- gid
- finger - GECOS
- dir - set automatically if blank (and uid is not)
- shell
- quota - (unimplementd)
- slipip - IP address
- radius_*Radius_Attribute* - *Radius-Attribute*
-METHODS
- create HASHREF
- Creates a new account. To add the account to the database,
- see the section on "insert".
-
- insert
- Adds this account 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.
-
- If the configuration value (see the FS::Conf manpage)
- shellmachine exists, and the username, uid, and dir fields
- are defined, the command
-
- useradd -d $dir -m -s $shell -u $uid $username
-
- is executed on shellmachine via ssh. This behaviour can be
- surpressed by setting $FS::svc_acct::nossh_hack true.
-
- 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.
-
- If the configuration value (see the FS::Conf manpage)
- shellmachine exists, the command:
-
- userdel $username
-
- is executed on shellmachine via ssh. This behaviour can be
- surpressed by setting $FS::svc_acct::nossh_hack true.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- If the configuration value (see the FS::Conf manpage)
- shellmachine exists, and the dir field has changed, the
- command:
-
- [ -d $old_dir ] && (
- chmod u+t $old_dir;
- umask 022;
- mkdir $new_dir;
- cd $old_dir;
- find . -depth -print | cpio -pdm $new_dir;
- chmod u-t $new_dir;
- chown -R $uid.$gid $new_dir;
- rm -rf $old_dir
- )
-
- is executed on shellmachine via ssh. This behaviour can be
- surpressed by setting $FS::svc_acct::nossh_hack true.
-
- suspend
- Suspends this account by prefixing *SUSPENDED* to the
- password. If there is an error, returns the error, otherwise
- returns false.
-
- Called by the suspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- unsuspend
- Unsuspends this account by removing *SUSPENDED* from the
- password. If there is an error, returns the error, otherwise
- returns false.
-
- Called by the unsuspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- cancel
- Just returns false (no error) for now.
-
- Called by the cancel method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- check
- Checks all fields to make sure this is a valid service. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- Sets any fixed values; see the FS::part_svc manpage.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- The remote commands should be configurable.
-
- The create method should set defaults from part_svc (like the
- check method sets fixed values).
-
-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.
-
-HISTORY
- ivan@voicenet.com 97-jul-16 - 21
-
- rewrite (among other things, now know about part_svc)
- ivan@sisd.com 98-mar-8
-
- Changed 'password' to '_password' because Pg6.3 reserves the
- password word bmccane@maxbaud.net 98-apr-3
-
- username length and shell no longer hardcoded ivan@sisd.com 98-
- jun-28
-
- eww but needed: ignore uid duplicates for 'fax' and 'hylafax'
- ivan@sisd.com 98-jun-29
-
- $nossh_hack ivan@sisd.com 98-jul-13
-
- protections against UID/GID of 0 for incorrectly-setup RDBMSs
- (also in bin/svc_acct.export) ivan@sisd.com 98-jul-13
-
- arbitrary radius attributes ivan@sisd.com 98-aug-13
-
- /var/spool/freeside/conf/shellmachine ivan@sisd.com 98-aug-13
-
- pod and FS::conf ivan@sisd.com 98-sep-22
-
+++ /dev/null
-NAME
- FS::svc_acct_pop - Object methods for svc_acct_pop records
-
-SYNOPSIS
- use FS::svc_acct_pop;
-
- $record = create FS::svc_acct_pop \%hash;
- $record = create FS::svc_acct_pop { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::svc_acct object represents an point of presence.
- FS::svc_acct_pop inherits from FS::Record. The following fields
- are currently supported:
-
- popnum - primary key (assigned automatically for new accounts)
- city
- state
- ac - area code
- exch - exchange
-METHODS
- create 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
- error, returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces 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 point of
- 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.
-
- It should be renamed to part_pop.
-
-SEE ALSO
- the FS::Record manpage, the svc_acct manpage, schema.html from
- the base documentation.
-
-HISTORY
- Class dealing with pops
-
- ivan@sisd.com 98-mar-8
-
- pod ivan@sisd.com 98-sep-23
-
+++ /dev/null
-NAME
- FS::svc_acct_sm - Object methods for svc_acct_sm records
-
-SYNOPSIS
- use FS::svc_acct_sm;
-
- $record = create FS::svc_acct_sm \%hash;
- $record = create FS::svc_acct_sm { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-DESCRIPTION
- An FS::svc_acct object represents a virtual mail alias.
- FS::svc_acct inherits from FS::Record. The following fields are
- currently supported:
-
- svcnum - primary key (assigned automatcially for new accounts)
- domsvc - svcnum of the virtual domain (see the FS::svc_domain manpage)
- domuid - uid of the target account (see the FS::svc_acct manpage)
- domuser - virtual username
-METHODS
- create HASHREF
- Creates a new virtual mail alias. To add the virtual mail
- alias to the database, see the section on "insert".
-
- insert
- Adds this virtual mail alias 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.
-
- If the configuration values (see the FS::Conf manpage)
- shellmachine and qmailmachines exist, and domuser is `*'
- (meaning a catch-all mailbox), the command:
-
- [ -e $dir/.qmail-$qdomain-default ] || {
- touch $dir/.qmail-$qdomain-default;
- chown $uid:$gid $dir/.qmail-$qdomain-default;
- }
-
- is executed on shellmachine via ssh (see the section on
- "EXTENSION ADDRESSES" in the dot-qmail manpage). This
- behaviour can be surpressed by setting
- $FS::svc_acct_sm::nossh_hack true.
-
- delete
- Deletes this virtual mail alias 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.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- suspend
- Just returns false (no error) for now.
-
- Called by the suspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- unsuspend
- Just returns false (no error) for now.
-
- Called by the unsuspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- cancel
- Just returns false (no error) for now.
-
- Called by the cancel method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- check
- Checks all fields to make sure this is a valid virtual mail
- alias. If there is an error, returns the error, otherwise
- returns false. Called by the insert and replace methods.
-
- Sets any fixed values; see the FS::part_svc manpage.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- The remote commands should be configurable.
-
-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::svc_acct manpage, the FS::svc_domain manpage, the FS::SSH
- manpage, the ssh manpage, the dot-qmail manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-16 - 21
-
- rewrite ivan@sisd.com 98-mar-10
-
- s/qsearchs/qsearch/ to eliminate warning ivan@sisd.com 98-apr-19
-
- uses conf/shellmachine and has an nossh_hack ivan@sisd.com 98-
- jul-14
-
- s/\./:/g in .qmail-domain:com ivan@sisd.com 98-aug-13
-
- pod, FS::Conf, moved .qmail file from check to insert 98-sep-23
-
+++ /dev/null
-NAME
- FS::svc_domain - Object methods for svc_domain records
-
-SYNOPSIS
- use FS::svc_domain;
-
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-DESCRIPTION
- An FS::svc_domain object represents a domain. FS::svc_domain
- inherits from FS::Record. The following fields are currently
- supported:
-
- svcnum - primary key (assigned automatically for new accounts)
- domain
-METHODS
- create HASHREF
- Creates a new domain. To add the domain to the database, see
- the section on "insert".
-
- insert
- Adds this domain 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.
-
- The additional field *action* should be set to *N* for new
- domains or *M* for transfers.
-
- A registration or transfer email will be submitted unless
- $FS::svc_domain::whois_hack is true.
-
- delete
- Deletes this domain 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.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- suspend
- Just returns false (no error) for now.
-
- Called by the suspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- unsuspend
- Just returns false (no error) for now.
-
- Called by the unsuspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- cancel
- Just returns false (no error) for now.
-
- Called by the cancel method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- check
- Checks all fields to make sure this is a valid domain. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- Sets any fixed values; see the FS::part_svc manpage.
-
- _whois
- Executes the command:
-
- whois do $domain
-
- and returns the output.
-
- (Always returns *No match for domian "$domain".* if
- $FS::svc_domain::whois_hack is set true.)
-
- submit_internic
- Submits a registration email for this domain.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- All BIND/DNS fields should be included (and exported).
-
- All registries should be supported.
-
- Not all configuration access is through FS::Conf!
-
- Should change action to a real field.
-
-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.
-
-HISTORY
- ivan@voicenet.com 97-jul-21
-
- rewrite ivan@sisd.com 98-mar-10
-
- add internic bits ivan@sisd.com 98-mar-14
-
- Changed 'day' to 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
- /var/spool/freeside/conf/registries/internic/, Mail::Internet,
- etc. ivan@sisd.com 98-jul-17-19
-
- pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
-
+++ /dev/null
-NAME
- FS::type_pkgs - Object methods for type_pkgs records
-
-SYNOPSIS
- use FS::type_pkgs;
-
- $record = create FS::type_pkgs \%hash;
- $record = create FS::type_pkgs { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::type_pkgs record links an agent type (see the
- FS::agent_type manpage) to a billing item definition (see the
- FS::part_pkg manpage). FS::type_pkgs inherits from FS::Record.
- The following fields are currently supported:
-
- typenum - Agent type, see the FS::agent_type manpage
- pkgpart - Billing item definition, see the FS::part_pkg manpage
-METHODS
- create HASHREF
- Create a new record. To add the record to the database, see
- the section on "insert".
-
- insert
- Adds this record to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this record from the database. If there is an error,
- returns the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces 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 record. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-HISTORY
- Defines the relation between agent types and pkgparts (Which
- pkgparts can the different [types of] agents sell?)
-
- ivan@sisd.com 97-nov-13
-
- change to ut_ FS::Record, fixed bugs ivan@sisd.com 97-dec-10
-
+++ /dev/null
-<head>
- <title>fs_passwd</title>
-</head>
-<body>
- <h1>fs_passwd</h1>
-You may use fs_passwd/fs_passwd as a "passwd", "chfn" and "chsh" replacement on your shell machine(s) to cause password, gecos and shell changes to update your freeside machine. This can pose a security risk if not configured correctly. <b>Do not use this feature unless you understand what you are doing!</b>
-<br><br>Currently it is assumed that the the crypt(3) function in the C library is the same on the Freeside machine as on the target machine.
-<ul>
- <li>Create a freeside account on the shell machine(s).
- <li>Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the shell machine(s).
- <li>Copy fs_passwd/fs_passwd to /usr/local/bin on the shell machine(s). (chown freeside, chmod 4755). You may link it to passwd, chfn and chsh as well.
- <li>Copy fs_passwd/fs_passwdd to /usr/local/sbin on the shell machine(s). (chown freeside, chmod 500)
- <li>Create /usr/local/freeside on the shell machine(s). (chown freeside, chmod 700)
- <li>Run an iteration of "fs_passwd/fs_passwd_server shell.machine" as the freeside user for each shell machine (this is a daemon process).
-</ul>
-</body>
+++ /dev/null
-<head>
- <title>Schema reference</title>
-</head>
-<body>
- <h1>Schema reference</h1>
- <ul>
- <li><a name="agent">agent</a> - Agents are resellers of your service. Agents may be limited to a subset of your full offerings (via their agent type).
- <ul>
- <li>agentnum - primary key
- <li>agent - name of this agent
- <li>typenum - <a href="#agent_type">agent type</a>
- <li>prog - (unimplemented)
- <li>freq - (unimplemented)
- </ul>
- <li><a name="agent_type">agent_type</a> - Agent types define groups of packages that you can then assign to particular agents.
- <ul>
- <li>typenum - primary key
- <li>atype - name of this agent type
- </ul>
- <li><a name="cust_bill">cust_bill</a> - Invoices
- <ul>
- <li>invnum - primary key
- <li>custnum - <a href="#cust_main">customer</a>
- <li>_date
- <li>charged - amount of this invoice
- <li>owed - amount still outstanding on this invoice
- <li>printed - how many times this invoice has been printed automatically
- </ul>
- <li><a name="cust_bill_pkg">cust_bill_pkg</a> - Invoice line items
- <ul>
- <li>invnum - (multiple) key
- <li>pkgnum - <a href="#cust_pkg">package</a>
- <li>setup - setup fee
- <li>recur - recurring fee
- <li>sdate - starting date
- <li>edate - ending date
- </ul>
- <li><a name="cust_credit">cust_credit</a> - Credits
- <ul>
- <li>crednum - primary key
- <li>custnum - <a href="#cust_main">customer</a>
- <li>amount - amount credited
- <li>credited - amount still outstanding (not yet refunded) on this credit
- <li>_date
- <li>otaker - order taker
- <li>reason
- </ul>
- <li><a name="cust_main">cust_main</a> - Customers
- <ul>
- <li>custnum - primary key
- <li>agentnum - <a href="#agent">agent</a>
- <li>refnum - <a href="#part_referral">referral</a>
- <li>first - name
- <li>last - name
- <li>ss - social security number
- <li>company
- <li>address1
- <li>address2
- <li>city
- <li>county
- <li>state
- <li>zip
- <li>country
- <li>daytime - phone
- <li>night - phone
- <li>payby - CARD, BILL, or COMP
- <li>payinfo - card number, P.O.#, or comp issuer
- <li>paydate - expiration date
- <li>payname - billing name (name on card)
- <li>tax - tax exempt, Y or null
- <li>otaker - order taker
- </ul>
- <li><a name="cust_main_county">cust_main_county</a> - Tax rates
- <ul>
- <li>taxnum - primary key
- <li>state
- <li>county
- <li>tax - % rate
- </ul>
- <li><a name="cust_pay">cust_pay</a> - Payments
- <ul>
- <li>paynum - primary key
- <li>invnum - <a href="#cust_bill">invoice</a>
- <li>paid - amount
- <li>_date
- <li>payby - CARD, BILL, or COMP
- <li>payinfo - card number, P.O.#, or comp issuer
- <li>paybatch - text field for tracking card processor batches
- </ul>
- <li><a name="cust_pay_batch">cust_pay_batch</a> - Pending batch
- <ul>
- <li>trancode - 77 for charges
- <li>cardnum
- <li>exp - card expiration
- <li>amount
- <li>invnum - <a href="#cust_bill">invoice</a>
- <li>custnum - <a href="#cust_main">customer</a>
- <li>payname - name on card
- <li>first - name
- <li>last - name
- <li>address1
- <li>address2
- <li>city
- <li>state
- <li>zip
- <li>country
- </ul>
- <li><a name="cust_pkg">cust_pkg</a> - Customer billing items
- <ul>
- <li>pkgnum - primary key
- <li>custnum - <a href="#cust_main">customer</a>
- <li>pkgpart - <a href="#part_pkg">Package definition</a>
- <li>setup - date
- <li>bill - next bill date
- <li>susp - (past) suspension date
- <li>expire - (future) cancellation date
- <li>cancel - (past) cancellation date
- <li>otaker - order taker
- </ul>
- <li><a name="cust_refund">cust_refund</a> - Refunds
- <ul>
- <li>refundnum - primary key
- <li>crednum - <a href="#cust_credit">credit</a>
- <li>refund - amount
- <li>_date
- <li>payby - CARD, BILL or COMP
- <li>payinfo - card number, P.O.#, or comp issuer
- <li>otaker - order taker
- </ul>
- <li><a name="cust_svc">cust_svc</a> - Customer services
- <ul>
- <li>svcnum - primary key
- <li>pkgnum - <a href="#cust_pkg">package</a>
- <li>svcpart - <a href="#part_svc">Service definition</a>
- </ul>
- <li><a name="part_pkg">part_pkg</a> - Package definitions
- <ul>
- <li>pkgpart - primary key
- <li>pkg - package name
- <li>comment - non-customer visable package comment
- <li>setup - setup fee
- <li>freq - recurring frequency (months)
- <li>recur - recurring fee
- </ul>
- <li><a name="part_referral">part_referral</a> - Referral listing
- <ul>
- <li>refnum</li> - primary key
- <li>referral</li> - referral
- </ul>
- <li><a name="part_svc">part_svc</a> - Service definitions
- <ul>
- <li>svcpart - primary key
- <li>svc - name of this service
- <li>svcdb - table used for this service: svc_acct, svc_acct_sm, svc_domain, svc_charge or svc_wo
- <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="pkg_svc">pkg_svc</a>
- <ul>
- <li>pkgpart - <a href="#part_pkg">Package definition</a>
- <li>svcpart - <a href="#part_svc">Service definition</a>
- <li>quantity - quantity of this service that this package includes
- </ul>
- <li><a name="svc_acct">svc_acct</a> - Accounts
- <ul>
- <li>svcnum - <a href="#cust_svc">primary key</a>
- <li>username
- <li>_password
- <li>popnum - <a href="#svc_acct_pop">Point of Presence</a>
- <li>uid
- <li>gid
- <li>finger - GECOS
- <li>dir
- <li>shell
- <li>quota - (unimplementd)
- <li>slipip - IP address
- <li>radius_<i>Radius_Attribute</i> - Radius-Attribute
- </ul>
- <li><a name="svc_acct_pop">svc_acct_pop</a> - Points of Presence
- <ul>
- <li>popnum - primary key
- <li>city
- <li>state
- <li>ac - area code
- <li>exch - exchange
- </ul>
- <li><a name="svc_acct_sm">svc_acct_sm</a> - Domain mail aliases
- <ul>
- <li>svcnum - <a href="#cust_svc">primary key</a>
- <li>domsvc - <a href="#svc_domain">Domain</a> (by svcnum)
- <li>domuid - <a href="#svc_acct">Account</a> (by uid)
- <li>domuser - domuser @ <a href="#svc_domain">Domain</a> forwards to <a href="#svc_acct">Account</a>
- </ul>
- <li><a name="svc_domain">svc_domain</a> - Domains
- <ul>
- <li>svcnum - <a href="#cust_svc">primary key</a>
- <li>domain
- </ul>
- <li><a name="type_pkgs">type_pkgs</a>
- <ul>
- <li>typenum - <a href="#agent_type">agent type</a>
- <li>pkgpart - <a href="#part_pkg">Package definition</a>
- </ul>
- </ul>
-</body>
+++ /dev/null
-<head>
- <title>Troubleshooting</title>
-</head>
-<body>
- <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.
-<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>,
-among others, should work fine.
- <li>If bin/svc_acct.import fails with an "Out of memory!" error using MySQL, upgrede MySQL and recompile the Perl DBD. There was a memory leak in some older versions of MySQL.
- <li>If you get tons of errors in your web server's error log like this:
-<pre>
-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:
-<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.
-Bad header=HTTP/1.0 302 Moved Temporarily
-</pre>
- Then you forgot to apply this <a href="CGI-modules-2.76-patch.txt">patch</a> as mentioned in the <a href="install.html">New Installation</a> section of the documentation.
- <li>If you get errors like this:
-<pre>
-UID.pm: Can't open /var/spool/freeside/conf/secrets: Permission denied
-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>
- </ul>
-</body>
+++ /dev/null
-<head>
- <title>Upgrading to 1.1.x</title>
-</head>
-<body>
-<h1>Upgrading to 1.1.x</h1>
-<ul>
- <li>Back up your data and current Freeside installation.
- <li>Unpack a copy of the 1.0.0 distribution in a separate location.
- <li>Diff your current installation against the 1.0.0 distribution.
- <li>Apply all the diffs you found above, if applicable.
- <li>Apply (at least) the following changes to your database:
-<pre>
-ALTER TABLE cust_main CHANGE ss ss char(11) NULL;
-ALTER TABLE cust_main CHANGE day daytime varchar(20) NULL;
-ALTER TABLE svc_acct CHANGE password _password varchar(25) NOT NULL;
-ALTER TABLE part_svc CHANGE svc_acct__password svc_acct___password varchar(25) NULL;
-ALTER TABLE part_svc CHANGE svc_acct__password_flag svc_acct___password_flag char(1) NULL;
-ALTER TABLE agent_type CHANGE type atype varchar(80) NOT NULL;
-</pre>
- <li>Optionally change the field lengths and types to match a 1.1.x install; see `bin/fs-setup'.
- <li>Create the necessary <a href="config.html">configuration files</a>,
- <li>Copy or symlink htdocs and site_perl to the new 1.1.x copies.
- <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.
-</body>
+++ /dev/null
-<head>
- <title>Upgrading to 1.1.3</title>
-</head>
-<body>
-<h1>Upgrading to 1.1.3 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.
- <li>If applicable, create the new <a href="config.html">configuration files</a>: lpr, cybercash2, cybercash3.2
- <li>Copy or symlink htdocs and site_perl to the new copies.
-</body>
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent.cgi: Add/Edit agent (output form)
-#
-# ivan@sisd.com 97-dec-12
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'type' to 'atype' because Pg6.3 reserves the type word
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($agent,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $agent=qsearchs('agent',{'agentnum'=>$1});
- $action='Edit';
-} else { #adding
- $agent=create FS::agent {};
- $action='Add';
-}
-my($hashref)=$agent->hashref;
-
-print header("$action Agent", menubar(
- 'Main Menu' => '../',
- 'View all agents' => '../browse/agent.cgi',
-)), '<FORM ACTION="process/agent.cgi" METHOD=POST>';
-
-print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
- "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
-
-print <<END;
-<PRE>
-Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}">
-Agent type <SELECT NAME="typenum" SIZE=1>
-END
-
-my($agent_type);
-foreach $agent_type (qsearch('agent_type',{})) {
- print "<OPTION";
- print " SELECTED"
- if $hashref->{typenum} == $agent_type->getfield('typenum');
- print ">", $agent_type->getfield('typenum'), ": ",
- $agent_type->getfield('atype'),"\n";
-}
-
-print <<END;
-</SELECT>
-Frequency (unimplemented) <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
-Program (unimplemented) <INPUT TYPE="text" NAME="prog" VALUE="$hashref->{prog}">
-</PRE>
-END
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{agentnum} ? "Apply changes" : "Add agent",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent_type.cgi: Add/Edit agent type (output form)
-#
-# ivan@sisd.com 97-dec-10
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'type' to 'atype' because Pg6.3 reserves the type word
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent_type;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($agent_type,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $agent_type=qsearchs('agent_type',{'typenum'=>$1});
- $action='Edit';
-} else { #adding
- $agent_type=create FS::agent_type {};
- $action='Add';
-}
-my($hashref)=$agent_type->hashref;
-
-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!<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>
-END
-
-my($part_pkg);
-foreach $part_pkg ( qsearch('part_pkg',{}) ) {
- print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
- $part_pkg->getfield('pkgpart'), qq!" !,
- # ( 'CHECKED 'x scalar(
- qsearchs('type_pkgs',{
- 'typenum' => $agent_type->getfield('typenum'),
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
- })
- ? 'CHECKED '
- : '',
- qq!"VALUE="ON"> !,$part_pkg->getfield('pkg')
- ;
-}
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{typenum} ? "Apply changes" : "Add agent type",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_credit.cgi: Add a credit (output form)
-#
-# 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.
-#
-# ivan@voicenet.com 96-dec-05
-#
-# paybatch field, differentiates between credits & credits+refunds by commandline
-# ivan@voicenet.com 96-dec-08
-#
-# added (but commented out) sprintf("%.2f" in amount field. Hmm.
-# ivan@voicenet.com 97-jan-3
-#
-# paybatch stuff thrown out - has checkbox now instead.
-# (well, sort of. still passed around for backward compatability and possible editing hook)
-# ivan@voicenet.com 97-apr-21
-#
-# rewrite ivan@sisd.com 98-mar-16
-
-use strict;
-use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); #CGI module
-use FS::UID qw(cgisuidsetup getotaker);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-
-#untaint otaker
-my($otaker)=getotaker;
-
-SendHeaders(); # one guess.
-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>
-END
-
-#crednum
-my($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">!;
-
-#amount
-my($amount)='';
-print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
-
-#refund?
-#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">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;
-</PRE>
-<BR>
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
-END
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main.cgi: Edit a customer (output form)
-#
-# 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.
-# ivan@voicenet.com 96-dec-16
-#
-# referral defaults to blank, to force people to pick something
-# ivan@voicenet.com 97-jun-4
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-28
-#
-# new customer is null, not '#'
-# otaker gotten from &getotaker instead of $ENV{REMOTE_USER}
-# ivan@sisd.com 97-nov-12
-#
-# cgisuidsetup($cgi);
-# no need for old_ fields.
-# now state+county is a select field (took out PA hack)
-# used autoloaded $cust_main->field methods
-# ivan@sisd.com 97-dec-17
-#
-# fixed quoting problems ivan@sisd.com 98-feb-23
-#
-# paydate sql update ivan@sisd.com 98-mar-5
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
-# Added test for paydate in mm-dd-yyyy format for Pg6.3 default format
-# bmccane@maxbaud.net 98-apr-3
-#
-# fixed one missed day->daytime ivan@sisd.com 98-jul-13
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::cust_main;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-#get record
-my($custnum,$action,$cust_main);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $custnum=$1;
- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
- $action='Edit';
-} else {
- $custnum='';
- $cust_main = create FS::cust_main ( {} );
- $cust_main->setfield('otaker',&getotaker);
- $cust_main->setfield('country','US');
- $action='Add';
-}
-
-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";
-}
-print "</SELECT>";
-
-#referral
-#unless ($custnum) {
- my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error
- 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";
- }
- print "</SELECT>";
-#}
-
-my($last,$first,$ss,$company,$address1,$address2,$city)=(
- $cust_main->last,
- $cust_main->first,
- $cust_main->ss,
- $cust_main->company,
- $cust_main->address1,
- $cust_main->address2,
- $cust_main->city,
-);
-
-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">
-END
-
-foreach ( qsearch('cust_main_county',{}) ) {
- print "<OPTION";
- print " SELECTED" if ( $cust_main->state eq $_->state
- && $cust_main->county eq $_->county );
- print ">",$_->state;
- print " (",$_->county,")" if $_->county;
-}
-print "</SELECT>";
-
-my($zip,$country,$daytime,$night,$fax)=(
- $cust_main->zip,
- $cust_main->country,
- $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">
-
-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>
-
-END
-
-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{$_}!;
-}
-
-
-my($payinfo,$payname,$otaker)=(
- $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='';
-}
-
-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;
-
-
-Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">
-</PRE>
-END
-
-print qq!<CENTER><INPUT TYPE="submit" VALUE="!,
- $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main_county-expand.cgi: Expand a state into counties (output form)
-#
-# ivan@sisd.com 97-dec-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-$cgi->var('QUERY_STRING') =~ /^(\d+)$/
- or die "Illegal taxnum!";
-my($taxnum)=$1;
-
-my($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>
- <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.
- <BR><INPUT TYPE="submit" VALUE="Submit">
- <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA>
- </FORM>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main_county.cgi: Edit tax rates (output form)
-#
-# ivan@sisd.com 97-dec-13-16
-#
-# Changes to allow page to work at a relative position in server
-# Changed tax field to accept 6 chars (MO uses 6.1%)
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-print header("Edit tax rates", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <FORM ACTION="process/cust_main_county.cgi" METHOD=POST>
- <TABLE BORDER>
- <TR>
- <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>
-END
-
- print "<TD>", $hashref->{county}
- ? $hashref->{county}
- : '(ALL)'
- , "</TD>";
-
- print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
- qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD></TR>!;
-END
-
-}
-
-print <<END;
- </TABLE>
- <INPUT TYPE="submit" VALUE="Apply changes">
- </FORM>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pay.cgi: Add a payment (output form)
-#
-# 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
-
-use strict;
-use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
-
-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>
- <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">!;
-
-#paid
-print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" 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
-print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
-
-print <<END;
-</PRE>
-<BR>
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
-END
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pkg.cgi: Add/edit packages (output form)
-#
-# 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
-#
-# Rewrote for new API
-# ivan@voicenet.com 97-jul-7
-#
-# FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
-#
-# Changes to allow page to work at a relative position in server
-# Changed to display packages 2-wide in a table
-# bmccane@maxbaud.net 98-apr-3
-#
-# fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
-# 98-jun-1
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-my(%pkg,%comment);
-foreach (qsearch('part_pkg', {})) {
- $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
- $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
-}
-
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-
-my($otaker)=&getotaker;
-
-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
-
-#custnum
-print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!;
-
-#current packages (except cancelled packages)
-my(@cust_pkg) = grep ! $_->getfield('cancel'),
- qsearch('cust_pkg',{'custnum'=>$custnum});
-
-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>
-END
-
- my ($count) = 0 ;
- print qq!<CENTER><TABLE>! ;
- foreach (@cust_pkg) {
- print qq!<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!;
- $count ++ ;
- if ($count == 2)
- {
- $count = 0 ;
- print qq!</TR>\n! ;
- }
- }
- print qq!</TABLE></CENTER>! ;
-
- print "<HR>";
-}
-
-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>
-END
-
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
-
-my($type_pkgs);
-my ($count) = 0 ;
-print qq!<CENTER><TABLE>! ;
-foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
- my($pkgpart)=$type_pkgs->pkgpart;
- print qq!<TR>! if ($count == 0) ;
- print <<END;
- <TD>
- <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2">
- $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
-END
- $count ++ ;
- if ($count == 2)
- {
- print qq!</TR>\n! ;
- $count = 0 ;
- }
-}
-print qq!</TABLE></CENTER>! ;
-
-#otaker
-print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!;
-
-#submit
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_pkg.cgi: Add/Edit package (output form)
-#
-# ivan@sisd.com 97-dec-10
-#
-# Changes to allow page to work at a relative position in server
-# Changed to display services 2-wide in table
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg;
-use FS::pkg_svc;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-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';
-}
-my($hashref)=$part_pkg->hashref;
-
-print header("$action Package Definition", menubar(
- 'Main Menu' => '../',
- 'View all packages' => '../browse/part_pkg.cgi',
-)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>';
-
-print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!,
- "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
-
-print <<END;
-<PRE>
-Package (customer-visable) <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}">
-Comment (customer-hidden) <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}">
-Setup fee for this package <INPUT TYPE="text" NAME="setup" VALUE="$hashref->{setup}">
-Recurring fee for this package <INPUT TYPE="text" NAME="recur" VALUE="$hashref->{recur}">
-Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
-
-</PRE>
-
-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'),
- 'svcpart' => $svcpart,
- }) || create FS::pkg_svc({
- 'pkgpart' => $part_pkg->getfield('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 ;
- }
-}
-print qq!</TR>! if ($count != 0) ;
-
-print "</TABLE>";
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{pkgpart} ? "Apply changes" : "Add package",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent.cgi: Add/Edit referral (output form)
-#
-# ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# confisuing typo on submit button ivan@sisd.com 98-jun-14
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_referral;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&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';
-} else { #adding
- $part_referral=create FS::part_referral {};
- $action='Add';
-}
-my($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
-
-#display
-
-print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!,
- "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
-
-print <<END;
-<PRE>
-Referral <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}">
-</PRE>
-END
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{refnum} ? "Apply changes" : "Add referral",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_svc.cgi: Add/Edit service (output form)
-#
-# ivan@sisd.com 97-nov-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-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);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($part_svc,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_svc=qsearchs('part_svc',{'svcpart'=>$1});
- $action='Edit';
-} else { #adding
- $part_svc=create FS::part_svc {};
- $action='Add';
-}
-my($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>';
-
-
-
-print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!,
- "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)";
-
-print <<END;
-<PRE>
-Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}">
-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>
-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)
-</UL>
-For the columns in the table selected above, you can set default or fixed
-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>
-<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)=(
- '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>',
- 'username' => 'Username',
- 'quota' => '(unimplemented)',
- '_password' => 'Password',
- 'gid' => 'GID (when blank, defaults to UID)',
- 'shell' => 'Shell',
- 'finger' => 'GECOS',
- },
- 'svc_domain' => {
- 'domain' => 'Domain',
- },
- 'svc_acct_sm' => {
- 'domuser' => 'domuser@virtualdomain.com',
- 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
- 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
- },
- 'svc_charge' => {
- 'amount' => 'amount',
- },
- 'svc_wo' => {
- 'worker' => 'Worker',
- '_date' => 'Date',
- },
-);
-
-my($svcdb);
-foreach $svcdb ( qw(
- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
-) ) {
-
- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc');
- my($rowspan)=scalar(@rows);
-
- my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>";
- my($row);
- foreach $row (@rows) {
- my($value)=$part_svc->getfield($svcdb.'__'.$row);
- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print "<TR>$ptmp<TD>$row - <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT></TD>";
- print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!.
- ' CHECKED'x($flag eq ''). "><BR>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>";
- $ptmp='';
- }
-}
-print "</TABLE>";
-
-print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{svcpart} ? "Apply changes" : "Add service",
- qq!"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/agent.cgi: Edit agent (process form)
-#
-# ivan@sisd.com 97-dec-12
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-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
-
-&cgisuidsetup($req->cgi);
-
-my($agentnum)=$req->param('agentnum');
-
-my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
-
-#unmunge typenum
-$req->param('typenum') =~ /^(\d+)(:.*)?$/;
-$req->param('typenum',$1);
-
-my($new)=create FS::agent ( {
- map {
- $_, $req->param($_);
- } fields('agent')
-} );
-
-my($error);
-if ( $agentnum ) {
- $error=$new->replace($old);
-} else {
- $error=$new->insert;
- $agentnum=$new->getfield('agentnum');
-}
-
-if ( $error ) {
- &idiot($error);
-} else {
- #$req->cgi->redirect("../../view/agent.cgi?$agentnum");
- #$req->cgi->redirect("../../edit/agent.cgi?$agentnum");
- $req->cgi->redirect("../../browse/agent.cgi");
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/agent_type.cgi: Edit agent type (process form)
-#
-# ivan@sisd.com 97-dec-11
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent_type qw(fields);
-use FS::type_pkgs;
-use FS::CGI qw(idiot);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-my($typenum)=$req->param('typenum');
-my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
-
-my($new)=create FS::agent_type ( {
- map {
- $_, $req->param($_);
- } fields('agent_type')
-} );
-
-my($error);
-if ( $typenum ) {
- $error=$new->replace($old);
-} else {
- $error=$new->insert;
- $typenum=$new->getfield('typenum');
-}
-
-if ( $error ) {
- idiot($error);
- exit;
-}
-
-my($part_pkg);
-foreach $part_pkg (qsearch('part_pkg',{})) {
- my($pkgpart)=$part_pkg->getfield('pkgpart');
-
- my($type_pkgs)=qsearchs('type_pkgs',{
- 'typenum' => $typenum,
- 'pkgpart' => $pkgpart,
- });
- if ( $type_pkgs && ! $req->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;
- }
-
- } elsif ( $req->param("pkgpart$pkgpart")
- && ! $type_pkgs
- ) {
- #ok to clobber it now (but bad form nonetheless?)
- $type_pkgs=create FS::type_pkgs ({
- 'typenum' => $typenum,
- 'pkgpart' => $pkgpart,
- });
- $error= $type_pkgs->insert;
- if ( $error ) {
- idiot($error);
- exit;
- }
- }
-
-}
-
-#$req->cgi->redirect("../../view/agent_type.cgi?$typenum");
-#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum");
-$req->cgi->redirect("../../browse/agent_type.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_credit.cgi: Add a credit (process form)
-#
-# 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
-# ivan@voicenet.com 96-dec-08
-#
-# refunds are no longer applied against a specific payment (paybatch)
-# paybatch field removed
-# ivan@voicenet.com 97-apr-22
-#
-# rewrite ivan@sisd.com 98-mar-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::cust_credit;
-
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
-my($custnum)=$1;
-
-$req->param('otaker',getotaker);
-
-my($new) = create FS::cust_credit ( {
- map {
- $_, $req->param($_);
- } qw(custnum _date amount otaker reason)
-} );
-
-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
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_main.cgi: Edit a customer (process form)
-#
-# 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
-# ivan@voicenet.com 97-jun-4
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-28
-#
-# same as above (again) and clean up some stuff ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_main;
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-#create new record object
-
-#unmunge agentnum
-$req->param('agentnum',
- (split(/:/, ($req->param('agentnum'))[0] ))[0]
-);
-
-#unmunge tax
-$req->param('tax','') unless defined($req->param('tax'));
-
-#unmunge refnum
-$req->param('refnum',
- (split(/:/, ($req->param('refnum'))[0] ))[0]
-);
-
-#unmunge state/county
-$req->param('state') =~ /^(\w+)( \((\w+)\))?$/;
-$req->param('state', $1);
-$req->param('county', $3 || '');
-
-my($new) = create 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)
-} );
-
-if ( $new->custnum eq '' ) {
-
- my($error)=$new->insert;
- &idiot($error) 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;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_main_county-expand.cgi: Expand counties (process form)
-#
-# ivan@sisd.com 97-dec-16
-#
-# Changes to allow page to work at a relative position in server
-# Added import of datasrc from UID.pm for Pg6.3
-# Default tax to 0.0 if using Pg6.3
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI
-# undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record
-# for that state
-#ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup datasrc);
-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);
-
-$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
-my($taxnum)=$1;
-my($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'));
-} else {
- die "Illegal delim!";
-}
-
-@counties=map {
- /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county");
- $1;
-} @counties;
-
-my($county);
-foreach ( @counties) {
- my(%hash)=$cust_main_county->hash;
- my($new)=create FS::cust_main_county \%hash;
- $new->setfield('taxnum','');
- $new->setfield('county',$_);
- #if (datasrc =~ m/Pg/)
- #{
- # $new->setfield('tax',0.0);
- #}
- my($error)=$new->insert;
- die $error if $error;
-}
-
-unless ( qsearch('cust_main',{
- 'state' => $cust_main_county->getfield('state'),
- 'county' => $cust_main_county->getfield('county'),
-} ) ) {
- my($error)=($cust_main_county->delete);
- die $error if $error;
-}
-
-$req->cgi->redirect("../../edit/cust_main_county.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/agent.cgi: Edit cust_main_county (process form)
-#
-# ivan@sisd.com 97-dec-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-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);
-
-foreach ( $req->params ) {
- /^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");
- my(%hash)=$old->hash;
- $hash{tax}=$req->param("tax$taxnum");
- my($new)=create FS::cust_main_county \%hash;
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-}
-
-$req->cgi->redirect("../../browse/cust_main_county.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_pay.cgi: Add a payment (process form)
-#
-# 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
-
-use strict;
-use CGI::Request;
-use FS::UID qw(cgisuidsetup);
-use FS::cust_pay qw(fields);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($invnum)=$1;
-
-my($new) = create FS::cust_pay ( {
- map {
- $_, $req->param($_);
- } qw(invnum paid _date payby payinfo paybatch)
-} );
-
-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");
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_pkg.cgi: Add/edit packages (process form)
-#
-# this is for changing packages around, not for editing things within the
-# package
-#
-# 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
-# ivan@voicenet.com 97-jul-7 - 15
-#
-# &cgisuidsetup($cgi) ivan@sisd.com 98-mar-7
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::cust_pkg;
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-#untaint custnum
-$req->param('new_custnum') =~ /^(\d+)$/;
-my($custnum)=$1;
-
-my(@remove_pkgnums) = map {
- /^(\d+)$/ or die "Illegal remove_pkg value!";
- $1;
-} $req->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;
- }
-}
-
-my($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
-} else {
- $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg");
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/part_pkg.cgi: Edit package definitions (process form)
-#
-# ivan@sisd.com 97-dec-10
-#
-# don't update non-changing records in part_svc (causing harmless but annoying
-# "Records identical" errors). ivan@sisd.com 98-feb-19
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg qw(fields);
-use FS::pkg_svc;
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($pkgpart)=$req->param('pkgpart');
-
-my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
-
-my($new)=create FS::part_pkg ( {
- map {
- $_, $req->param($_);
- } fields('part_pkg')
-} );
-
-if ( $pkgpart ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $pkgpart=$new->getfield('pkgpart');
-}
-
-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;
- next unless $old_quantity != $quantity; #!here
- my($new_pkg_svc)=create FS::pkg_svc({
- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->getfield('svcpart'),
- #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')),
- 'quantity' => $quantity,
- });
- if ($old_pkg_svc) {
- my($error)=$new_pkg_svc->replace($old_pkg_svc);
- eidiot($error) if $error;
- } else {
- my($error)=$new_pkg_svc->insert;
- eidiot($error) if $error;
- }
-}
-
-#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart");
-#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart");
-$req->cgi->redirect("../../browse/part_pkg.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/part_referral.cgi: Edit referrals (process form)
-#
-# ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-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
-
-&cgisuidsetup($req->cgi);
-
-my($refnum)=$req->param('refnum');
-
-my($new)=create FS::part_referral ( {
- map {
- $_, $req->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;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
-}
-
-$refnum=$new->getfield('refnum');
-$req->cgi->redirect("../../browse/part_referral.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/part_svc.cgi: Edit service definitions (process form)
-#
-# ivan@sisd.com 97-nov-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-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
-
-&cgisuidsetup($req->cgi);
-
-my($svcpart)=$req->param('svcpart');
-
-my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
-
-my($new)=create FS::part_svc ( {
- map {
- $_, $req->param($_);
-# } qw(svcpart svc svcdb)
- } fields('part_svc')
-} );
-
-if ( $svcpart ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $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");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_acct.cgi: Add/edit a customer (process form)
-#
-# 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
-# ivan@voicenet.com 97-may-6
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-17 - 21
-#
-# no FS::Search, FS::svc_acct creates FS::cust_svc record, used for adding
-# and editing ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'password' to '_password' because Pg6.3 reserves the password word
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_acct;
-
-my($req) = new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
-
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
-
-my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum;
-
-#unmunge popnum
-$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] );
-
-#unmunge passwd
-if ( $req->param('_password') eq '*HIDDEN*' ) {
- $req->param('_password',$old->getfield('_password'));
-}
-
-my($new) = create FS::svc_acct ( {
- map {
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
- shell quota slipip)
-} );
-
-if ( $svcnum ) {
- my($error) = $new->replace($old);
- &idiot($error) if $error;
-} else {
- my($error) = $new->insert;
- &idiot($error) if $error;
- $svcnum = $new->getfield('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;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_acct_pop.cgi: Edit POP (process form)
-#
-# ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-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);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($popnum)=$req->param('popnum');
-
-my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
-
-my($new)=create FS::svc_acct_pop ( {
- map {
- $_, $req->param($_);
- } fields('svc_acct_pop')
-} );
-
-if ( $popnum ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $popnum=$new->getfield('popnum');
-}
-$req->cgi->redirect("../../browse/svc_acct_pop.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_acct_sm.cgi: Add/edit a mail alias (process form)
-#
-# 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
-#
-# enabled modifications
-#
-# ivan@voicenet.com 97-may-7
-#
-# fixed removal of cust_svc record on modifications!
-# ivan@voicenet.com 97-jun-5
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_acct_sm;
-
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
-
-my($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] );
-
-my($new) = create FS::svc_acct_sm ( {
- map {
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
-} );
-
-my($error);
-if ( $svcnum ) {
- $error = $new->replace($old);
-} else {
- $error = $new->insert;
- $svcnum = $new->getfield('svcnum');
-}
-
-unless ($error) {
- $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum");
-} 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
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_domain.cgi: Add a domain (process form)
-#
-# 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
-#
-# kludged for new domain template 3.5
-# ivan@voicenet.com 97-jul-24
-#
-# moved internic bits to svc_domain.pm ivan@sisd.com 98-mar-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_domain;
-
-#remove this to actually test the domains!
-$FS::svc_domain::whois_hack = 1;
-
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
-
-my($new) = create FS::svc_domain ( {
- map {
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart domain action purpose)
-} );
-
-my($error);
-if ($req->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')) {
- $error="Can't modify a domain!";
-} else {
- $error=$new->insert;
- $svcnum=$new->svcnum;
-}
-
-unless ($error) {
- $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum");
-} 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
-
-}
-
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct.cgi: Add/edit account (output form)
-#
-# 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
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'password' to '_password' because Pg6.3 reserves the password word
-# bmccane@maxbaud.net 98-apr-3
-#
-# use conf/shells and dbdef username length ivan@sisd.com 98-jul-13
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-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!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_acct=create FS::svc_acct({});
-
- 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='';
-
- #set gecos
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- if ($cust_pkg) {
- my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
- $svc_acct->setfield('finger',
- $cust_main->getfield('first') . " " . $cust_main->getfield('last')
- ) ;
- }
-
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) {
- $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
- $action="Add";
-
-}
-
-my($svc)=$part_svc->getfield('svc');
-
-my($otaker)=getotaker;
-
-my($username,$password)=(
- $svc_acct->username,
- $svc_acct->_password ? "*HIDDEN*" : '',
-);
-
-my($ulen)=$svc_acct->dbdef_table->column('username')->length;
-my($ulen2)=$ulen+2;
-
-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>
- <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
- <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
-Username:
-<INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen>
-<BR>Password:
-<INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
-(blank to generate)
-END
-
-#pop
-my($popnum)=$svc_acct->popnum || 0;
-if ( $part_svc->svc_acct__popnum_flag eq "F" ) {
- print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
-} else {
- print qq!<BR>POP: <SELECT NAME="popnum" SIZE=1><OPTION>\n!;
- my($svc_acct_pop);
- foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
- print "<OPTION", $svc_acct_pop->popnum == $popnum ? ' SELECTED' : '', ">",
- $svc_acct_pop->popnum, ": ",
- $svc_acct_pop->city, ", ",
- $svc_acct_pop->state,
- "(", $svc_acct_pop->ac, ")/",
- $svc_acct_pop->exch, "\n"
- ;
- }
- print "</SELECT>";
-}
-
-my($uid,$gid,$finger,$dir)=(
- $svc_acct->uid,
- $svc_acct->gid,
- $svc_acct->finger,
- $svc_acct->dir,
-);
-
-print <<END;
-<INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
-<INPUT TYPE="hidden" NAME="gid" VALUE="$gid">
-<BR>GECOS: <INPUT TYPE="text" NAME="finger" VALUE="$finger">
-<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">
-END
-
-my($shell)=$svc_acct->shell;
-if ( $part_svc->svc_acct__shell_flag eq "F" ) {
- print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
-} else {
- print qq!<BR>Shell: <SELECT NAME="shell" SIZE=1>!;
- my($etc_shell);
- foreach $etc_shell (@shells) {
- print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">",
- $etc_shell, "\n";
- }
- print "</SELECT>";
-}
-
-my($quota,$slipip)=(
- $svc_acct->quota,
- $svc_acct->slipip,
-);
-
-print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!;
-
-if ( $part_svc->svc_acct__slipip_flag eq "F" ) {
- print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!;
-} else {
- print qq!<BR>IP: <INPUT TYPE="text" NAME="slipip" VALUE="$slipip">!;
-}
-
-#submit
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_pop.cgi: Add/Edit pop (output form)
-#
-# ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_pop;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($svc_acct_pop,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
- $action='Edit';
-} else { #adding
- $svc_acct_pop=create FS::svc_acct_pop {};
- $action='Add';
-}
-my($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
-
-#display
-
-print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!,
- "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)";
-
-print <<END;
-<PRE>
-City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
-State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 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>
-END
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{popnum} ? "Apply changes" : "Add POP",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_sm.cgi: Add/edit a mail alias (output form)
-#
-# 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
-#
-# added debugging code; fixed CPU-sucking problem with trying to edit an (unaudited) mail alias (no pkgnum)
-#
-# ivan@voicenet.com 97-may-7
-#
-# fixed uid selection
-# ivan@voicenet.com 97-jun-4
-#
-# uid selection across _CUSTOMER_, not just _PACKAGE_
-#
-# ( i need to be rewritten with fast searches)
-#
-# ivan@voicenet.com 97-oct-3
-#
-# added fast searches in some of the places where it is sorely needed...
-# I see DBI::mysql in your future...
-# ivan@voicenet.com 97-oct-23
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-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.
-
-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!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_acct_sm=create FS::svc_acct_sm({});
-
- 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;
-
- $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='Add';
-
-}
-
-my(%username,%domain);
-if ($pkgnum) {
-
- #find all possible uids (and usernames)
-
- my($u_part_svc,@u_acct_svcparts);
- foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
- push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
- }
-
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- my($custnum)=$cust_pkg->getfield('custnum');
- my($i_cust_pkg);
- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
- my($acct_svcpart);
- foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
- #record(s) in cust_svc ( for this
- #pkgnum ! )
- my($i_cust_svc);
- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
- $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
- }
- }
- }
-
- #find all possible domains (and domsvc's)
-
- my($d_part_svc,@d_acct_svcparts);
- foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
- push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
- }
-
- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
- my($acct_svcpart);
- foreach $acct_svcpart (@d_acct_svcparts) {
- my($i_cust_svc);
- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
- my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
- $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
- }
- }
- }
-
-} elsif ( $action eq 'Edit' ) {
-
- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
- $username{$svc_acct_sm->uid} = $svc_acct->username;
-
- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
- $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
-
-} else {
- die "\$action eq Add, but \$pkgnum is null!\n";
-}
-
-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
-
-#display
-
- #formatting
- print "<PRE>";
-
-#svcnum
-print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
-print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
-
-#pkgnum
-print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
-
-#svcpart
-print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
-
-my($domuser,$domsvc,$domuid)=(
- $svc_acct_sm->domuser,
- $svc_acct_sm->domsvc,
- $svc_acct_sm->domuid,
-);
-
-#domuser
-print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
-
-#domsvc
-print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
-foreach $_ (keys %domain) {
- print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}";
-}
-print "</SELECT>";
-
-#uid
-print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
-foreach $_ (keys %username) {
- print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}";
-}
-print "</SELECT>\@$mydomain mailbox.";
-
- #formatting
- print "</PRE>\n";
-
-print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_domain.cgi: Add domain (output form)
-#
-# 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
-# ivan@voicenet.com 97-jul-24
-#
-# rewrite ivan@sisd.com 98-mar-14
-#
-# no GOV in instructions ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_domain qw(fields);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&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!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_domain=create 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;
-
- $svcnum='';
-
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_domain') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) {
- $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
- }
- }
-
- $action="Add";
-
-}
-
-my($svc)=$part_svc->getfield('svc');
-
-my($otaker)=getotaker;
-
-my($domain)=(
- $svc_domain->domain,
-);
-
-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>
- <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
-
-<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>
-<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
-<UL>
- <LI>COM is for commercial, for-profit organziations
- <LI>ORG is for miscellaneous, usually, non-profit organizations
- <LI>NET is for network infrastructure machines and organizations
- <LI>EDU is for 4-year, degree granting institutions
-<!-- <LI>GOV is for United States federal government agencies
-!-->
-</UL>
-US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain
-and registration procedures.
-<P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816).
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>
- Freeside Main Menu
- </TITLE>
- </HEAD>
- <BODY BGCOLOR="#FFFFFF">
- <table>
- <tr><td>
- <P ALIGN=CENTER>
- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.gif">
- </td><td>
- <center><font color="#ff0000" size=7>freeside main menu</font></center>
- </td></tr>
- </table>
- <A HREF="http://www.sisd.com/freeside">
- Information
- </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>
- <LI><A HREF="search/cust_main.html">
- customers (by last name and/or company)
- </A>
- <LI><A HREF="search/cust_main-payinfo.html">customers (by credit card number)</A>
- <LI><A HREF="search/svc_acct.html">accounts (by username)</A>
- <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>
- <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>
- <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
- <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
- <LI><A HREF="search/svc_acct.cgi?svcnum">accounts (by service number)</A>
- <LI><A HREF="search/svc_acct.cgi?username">accounts (by username)</A>
- <LI><A HREF="search/svc_acct.cgi?uid">accounts (by uid)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_svcnum">unlinked accounts (by service number)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_username">unlinked accounts (by username)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_uid">unlinked accounts (by uid)</A>
- <LI><A HREF="search/svc_domain.cgi?svcnum">domains (by service number)</A>
- <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>
- <LI><A HREF="browse/part_svc.cgi">
- View/Edit services
- </A>
- - Services are items you offer to your customers.
- <LI><A HREF="browse/part_pkg.cgi">
- View/Edit packages
- </A>
- - One or more services are grouped together into a package and
- given pricing information. Customers purchase packages, not
- services.
- <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.
- <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>
- <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>
- <LI><A HREF="browse/svc_acct_pop.cgi">
- View/Edit POPs
- </A>
- - Points of Presence
- </MENU>
- </FONT>
- </BODY>
-</HTML>
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# 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
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::Bill;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint custnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($custnum)=$1;
-my($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;
-
-$error = $cust_main->collect(
-# 'invoice-time'=>$time,
-# 'batch_card'=> 'yes',
- '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;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cancel-unaudited.cgi: Cancel an unaudited account
-#
-# 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
-# ivan@voicenet.com 97-jul-21
-#
-# Search->Record, cgisuidsetup($cgi) ivan@sids.com 98-mar-19
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_svc;
-use FS::svc_acct;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-
-my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum});
-&idiot("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') .
- qq!pkgnum"> package</A> instead.!)
- if $cust_svc->getfield('pkgnum') ne '';
-
-local $SIG{HUP} = 'IGNORE';
-local $SIG{INT} = 'IGNORE';
-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;
-$error = $svc_acct->delete;
-&idiot($error) if $error;
-
-bless($cust_svc,"FS::cust_svc");
-$error = $cust_svc->delete;
-&idiot($error) if $error;
-
-$cgi->redirect("../");
-
-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;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cancel_pkg.cgi: Cancel a package
-#
-# 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.
-#
-# ivan@voicenet.com 97-jan-2
-#
-# still kludgy, but now runs /dbin/cancel $pkgnum
-# ivan@voicenet.com 97-feb-27
-#
-# doesn't run if pkgnum doesn't match regex
-# ivan@voicenet.com 97-mar-6
-#
-# now redirects to enter comments
-# ivan@voicenet.com 97-may-8
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-use FS::CGI qw(idiot);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->cancel;
-idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# expire_pkg.cgi: Expire a package
-#
-# 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
-#
-# ivan@sisd.com 98-mar-17 FS::Search->FS::Record
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use Date::Parse;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-#untaint date & pkgnum
-
-my($date);
-if ( $req->param('date') ) {
- str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date";
- $date=$1;
-} else {
- $date='';
-}
-
-$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my(%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'));
-
-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;
-}
-
+++ /dev/null
-#!/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
-#
-# 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
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my(%link_field)=(
- 'svc_acct' => 'username',
- 'svc_domain' => 'domain',
- 'svc_acct_sm' => '',
- 'svc_charge' => '',
- 'svc_wo' => '',
-);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-my($pkgnum,$svcpart);
-foreach $_ (split(/-/,$QUERY_STRING)) { #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};
-
-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
-
-if ( $link_field ) {
- print <<END;
- <INPUT TYPE="hidden" NAME="svcnum" VALUE="">
- <INPUT TYPE="hidden" NAME="link_field" VALUE="$link_field">
- $link_field of existing service: <INPUT TYPE="text" NAME="link_value">
-END
-} else {
- print qq!Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">!;
-}
-
-print <<END;
-<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
-<P><CENTER><INPUT TYPE="submit" VALUE="Link"></CENTER>
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# 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
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::Invoice;
-
-my($lpr) = "|lpr -h";
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint invnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($invnum)=$1;
-my($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: $!";
- 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;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/link.cgi: link to existing customer (process form)
-#
-# ivan@voicenet.com 97-feb-5
-#
-# rewrite ivan@sisd.com 98-mar-18
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::CGI qw(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';
-
-$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
-$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
-
-$req->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;
- $svcnum=$svc_acct->svcnum;
-}
-
-my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-die "svcnum not found!" unless $old;
-my($new)=create 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");
-} 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
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# susp_pkg.cgi: Suspend a package
-#
-# 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
-#
-# now redirects to enter comments
-# ivan@voicenet.com 97-may-8
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->suspend;
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-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;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# susp_pkg.cgi: Unsuspend a package
-#
-# 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
-#
-# now redirects to enter comments
-# ivan@voicenet.com 97-may-8
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->unsuspend;
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-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;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_bill.cgi: Search for invoices (process form)
-#
-# 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
-
-use strict;
-use CGI::Request;
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my($req)=new CGI::Request;
-cgisuidsetup($req->cgi);
-
-$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
-my($invnum)=$2;
-
-if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) {
- $req->cgi->redirect("../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
-
-}
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Invoice Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Invoice Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="cust_bill.cgi" METHOD="post">
- Search for <B>invoice #</B>:
- <INPUT TYPE="text" NAME="invnum">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
- </BODY>
-</HTML>
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Customer Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="cust_main.cgi" METHOD="post">
- Search for <B>Credit card #</B>:
- <INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE">
- <INPUT TYPE="text" NAME="card">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
- <HR>
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_main.cgi: Search for customers (process form)
-#
-# 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
-#
-# now does browsing too ivan@sisd.com 98-mar-6
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# display total, use FS::CGI ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use IO::Handle;
-use IPC::Open2;
-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',{});
-} else {
- &cardsearch if ($req->param('card_on') );
- &lastsearch if ($req->param('last_on') );
- &companysearch if ($req->param('company_on') );
-}
-
-if ( scalar(@cust_main) == 1 ) {
- $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum);
- exit;
-} elsif ( scalar(@cust_main) == 0 ) {
- idiot "No matching customers found!\n";
- exit;
-} 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>
- <TR>
- <TH>Cust. #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$cust_main);
- foreach $cust_main (
- sort $sortby grep(!$saw{$_->custnum}++, @cust_main)
- ) {
- my($custnum,$last,$first,$company)=(
- $cust_main->custnum,
- $cust_main->getfield('last'),
- $cust_main->getfield('first'),
- $cust_main->company,
- );
- 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>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
-}
-
-#
-
-sub last_sort {
- $a->getfield('last') cmp $b->getfield('last');
-}
-
-sub company_sort {
- $a->getfield('company') cmp $b->getfield('company');
-}
-
-sub custnum_sort {
- $a->getfield('custnum') <=> $b->getfield('custnum');
-}
-
-sub cardsearch {
-
- my($card)=$req->param('card');
- $card =~ s/\D//g;
- $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; };
- my($payinfo)=$1;
-
- push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
-
-}
-
-sub lastsearch {
- my(%last_type);
- foreach ( $req->param('last_type') ) {
- $last_type{$_}++;
- }
-
- $req->param('last_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal last name"; exit; };
- my($last)=$1;
-
- if ( $last_type{'Exact'}
- && ! $last_type{'Fuzzy'}
- # && ! $last_type{'Sound-alike'}
- ) {
-
- push @cust_main, qsearch('cust_main',{'last'=>$last});
-
- } else {
-
- my(%last);
-
- 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;
- }
-
- #if ($last_type{'Sound-alike'}) {
- #}
-
- foreach ( keys %last ) {
- push @cust_main, qsearch('cust_main',{'last'=>$_});
- }
-
- }
- $sortby=\*last_sort;
-}
-
-sub companysearch {
-
- my(%company_type);
- foreach ( $req->param('company_type') ) {
- $company_type{$_}++
- };
-
- $req->param('company_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal company"; exit; };
- my($company)=$1;
-
- if ( $company_type{'Exact'}
- && ! $company_type{'Fuzzy'}
- # && ! $company_type{'Sound-alike'}
- ) {
-
- push @cust_main, qsearch('cust_main',{'company'=>$company});
-
- } else {
-
- my(%company);
- 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;
- $company{$_}++;
- }
- close $reader;
- }
-
- #if ($company_type{'Sound-alike'}) {
- #}
-
- foreach ( keys %company ) {
- push @cust_main, qsearch('cust_main',{'company'=>$_});
- }
-
- }
- $sortby=\*company_sort;
-
-}
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Customer Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="cust_main.cgi" METHOD="post">
- <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>:
- <INPUT TYPE="text" NAME="last_text">
- using search method(s): <SELECT NAME="last_type" MULTIPLE>
- <OPTION SELECTED>Fuzzy
- <OPTION>Exact
- </SELECT>
-
- <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>:
- <INPUT TYPE="text" NAME="company_text">
- using search methods(s): <SELECT NAME="company_type" MULTIPLE>
- <OPTION SELECTED>Fuzzy
- <OPTION>Exact
- </SELECT>
-
- <P><INPUT TYPE="submit" VALUE="Search"> Note: Fuzzy searching can take a while. Please be patient.
-
- </FORM>
-
- <HR>Explanation of search methods:
- <UL>
- <LI><B>Fuzzy</B> - Searches for matches that are close to your text.
- <LI><B>Exact</B> - Finds exact matches only, but much faster than the other search methods.
- </UL>
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pkg.cgi: search/browse for packages
-#
-# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Request;
-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);
-
-my(@cust_pkg,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-#this tree is a little bit redundant
-if ( $query eq 'pkgnum' ) {
- $sortby=\*pkgnum_sort;
- @cust_pkg=qsearch('cust_pkg',{});
-} elsif ( $query eq 'APKG_pkgnum' ) {
- $sortby=\*pkgnum_sort;
-
- #perhaps this should go in cust_pkg as a qsearch-like constructor?
- my($cust_pkg);
- foreach $cust_pkg (qsearch('cust_pkg',{})) {
- my($flag)=0;
- my($pkg_svc);
- PKG_SVC:
- foreach $pkg_svc (qsearch('pkg_svc',{ 'pkgpart' => $cust_pkg->pkgpart })) {
- if ( $pkg_svc->quantity
- > scalar(qsearch('cust_svc',{
- 'pkgnum' => $cust_pkg->pkgnum,
- 'svcpart' => $pkg_svc->svcpart,
- }))
- )
- {
- $flag=1;
- last PKG_SVC;
- }
- }
- push @cust_pkg, $cust_pkg if $flag;
- }
-} else {
- die "Empty QUERY_STRING!";
-}
-
-if ( scalar(@cust_pkg) == 1 ) {
- my($pkgnum)=$cust_pkg[0]->pkgnum;
- $req->cgi->redirect("../view/cust_pkg.cgi?$pkgnum");
- exit;
-} elsif ( scalar(@cust_pkg) == 0 ) { #error
- &idiot("No packages found");
- exit;
-} else {
- my($total)=scalar(@cust_pkg);
- CGI::Base::SendHeaders(); # one guess
- print 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>Company</TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$cust_pkg);
- foreach $cust_pkg (
- sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg)
- ) {
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
- my($pkgnum,$custnum,$name,$company)=(
- $cust_pkg->pkgnum,
- $cust_main->custnum,
- $cust_main->last. ', '. $cust_main->first,
- $cust_main->company,
- );
- 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>
- </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
- exit;
-
-}
-
-sub pkgnum_sort {
- $a->getfield('pkgnum') <=> $b->getfield('pkgnum');
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct.cgi: Search for customers (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_acct.cgi
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# loosely (sp?) based on search/cust_main.cgi
-#
-# ivan@voicenet.com 96-jan-3 -> 96-jan-4
-#
-# rewrite (now does browsing too) ivan@sisd.com 98-mar-9
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# show unlinked accounts ivan@sisd.com 98-jun-22
-#
-# use FS::CGI, show total ivan@sisd.com 98-jul-17
-#
-# give service and customer info too ivan@sisd.com 98-aug-16
-
-use strict;
-use CGI::Request; # form processing module
-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; # create form object
-&cgisuidsetup($req->cgi);
-
-my(@svc_acct,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-#this tree is a little bit redundant
-if ( $query eq 'svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_acct=qsearch('svc_acct',{});
-} elsif ( $query eq 'username' ) {
- $sortby=\*username_sort;
- @svc_acct=qsearch('svc_acct',{});
-} elsif ( $query eq 'uid' ) {
- $sortby=\*uid_sort;
- @svc_acct=grep $_->uid ne '', qsearch('svc_acct',{});
-} elsif ( $query eq 'UN_svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_acct = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_acct',{});
-} elsif ( $query eq 'UN_username' ) {
- $sortby=\*username_sort;
- @svc_acct = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_acct',{});
-} elsif ( $query eq 'UN_uid' ) {
- $sortby=\*uid_sort;
- @svc_acct = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_acct',{});
-} else {
- &usernamesearch;
-}
-
-if ( scalar(@svc_acct) == 1 ) {
- my($svcnum)=$svc_acct[0]->svcnum;
- $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect
- exit;
-} elsif ( scalar(@svc_acct) == 0 ) { #error
- idiot("Account not found");
- exit;
-} else {
- my($total)=scalar(@svc_acct);
- CGI::Base::SendHeaders(); # one guess
- print header("Account Search Results",''), <<END;
- $total matching accounts found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Username</TH>
- <TH>UID</TH>
- <TH>Service</TH>
- <TH>Customer #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$svc_acct);
- foreach $svc_acct (
- sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct)
- ) {
- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct->svcnum })
- or die "No cust_svc record for svcnum ". $svc_acct->svcnum;
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $cust_svc->svcpart })
- or die "No part_svc record for svcpart ". $cust_svc->svcpart;
- my($cust_pkg,$cust_main);
- if ( $cust_svc->pkgnum ) {
- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc->pkgnum })
- or die "No cust_pkg record for pkgnum ". $cust_svc->pkgnum;
- $cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg->custnum })
- or die "No cust_main record for custnum ". $cust_pkg->custnum;
- }
- my($svcnum,$username,$uid,$svc,$custnum,$last,$first,$company)=(
- $svc_acct->svcnum,
- $svc_acct->getfield('username'),
- $svc_acct->getfield('uid'),
- $part_svc->svc,
- $cust_svc->pkgnum ? $cust_main->custnum : '',
- $cust_svc->pkgnum ? $cust_main->getfield('last') : '',
- $cust_svc->pkgnum ? $cust_main->getfield('first') : '',
- $cust_svc->pkgnum ? $cust_main->company : '',
- );
- my($pcustnum) = $custnum
- ? "<A HREF=\"../view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
- : "<I>(unlinked)</I>"
- ;
- my($pname) = $custnum ? "$last, $first" : '';
- print <<END;
- <TR>
- <TD><A HREF="../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>
- </TR>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
- exit;
-
-}
-
-sub svcnum_sort {
- $a->getfield('svcnum') <=> $b->getfield('svcnum');
-}
-
-sub username_sort {
- $a->getfield('username') cmp $b->getfield('username');
-}
-
-sub uid_sort {
- $a->getfield('uid') <=> $b->getfield('uid');
-}
-
-sub usernamesearch {
-
- $req->param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text
- my($username)=$1;
-
- @svc_acct=qsearch('svc_acct',{'username'=>$username});
-
-}
-
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Account Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Account Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="svc_acct.cgi" METHOD="post">
- Search for <B>username</B>:
- <INPUT TYPE="text" NAME="username">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_sm.cgi: Search for domains (process form)
-#
-# 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
-#
-# ivan@voicenet.com
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch 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($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
-
-$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
-my($domuser)=$1;
-
-$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
-my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1})
- or die "Unknown domain";
-my($domsvc)=$svc_domain->svcnum;
-
-my(@svc_acct_sm);
-if ($domuser) {
- @svc_acct_sm=qsearch('svc_acct_sm',{
- 'domuser' => $domuser,
- 'domsvc' => $domsvc,
- });
-} else {
- @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
-}
-
-if ( scalar(@svc_acct_sm) == 1 ) {
- my($svcnum)=$svc_acct_sm[0]->svcnum;
- $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect
-} 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>
- <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>
- </TR>
-END
-
- 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});
- 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
-
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
-} 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
-
-}
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Mail Alias Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Mail Alias Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="svc_acct_sm.cgi" METHOD="post">
- Search for <B>mail alias</B>:
- <INPUT TYPE="text" NAME="domuser"><FONT SIZE=-1>(opt.)</FONT> @
- <INPUT TYPE="text" NAME="domain"><FONT SIZE=-1>(req.)</FONT>
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
-
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_domain.cgi: Search for domains (process form)
-#
-# 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
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Request;
-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);
-
-my(@svc_domain);
-my($sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-if ( $query eq 'svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_domain=qsearch('svc_domain',{});
-} elsif ( $query eq 'domain' ) {
- $sortby=\*domain_sort;
- @svc_domain=qsearch('svc_domain',{});
-} elsif ( $query eq 'UN_svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_domain = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_domain',{});
-} elsif ( $query eq 'UN_domain' ) {
- $sortby=\*domain_sort;
- @svc_domain = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_domain',{});
-} else {
- $req->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);
- exit;
-} elsif ( scalar(@svc_domain) == 0 ) {
- idiot "No matching domains found!\n";
- exit;
-} else {
- CGI::Base::SendHeaders(); # one guess
-
- my($total)=scalar(@svc_domain);
- CGI::Base::SendHeaders(); # one guess
- print 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>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$svc_domain);
- foreach $svc_domain (
- sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain)
- ) {
- my($svcnum,$domain)=(
- $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='';
- }
- 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>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
-}
-
-sub svcnum_sort {
- $a->getfield('svcnum') <=> $b->getfield('svcnum');
-}
-
-sub domain_sort {
- $a->getfield('domain') cmp $b->getfield('doimain');
-}
-
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Domain Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Domain Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="svc_domain.cgi" METHOD="post">
- Search for <B>domain</B>:
- <INPUT TYPE="text" NAME="domain">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
-
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/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.
-#
-# this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice
-#
-# ivan@voicenet.com 96-dec-05
-#
-# added navigation bar
-# ivan@voicenet.com 97-jan-30
-#
-# now uses Invoice.pm
-# ivan@voicenet.com 97-jun-30
-#
-# what to do if cust_bill search errors?
-# ivan@voicenet.com 97-jul-7
-#
-# s/FS::Search/FS::Record/; $cgisuidsetup($cgi); ivan@sisd.com 98-mar-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# also print 'printed' field ivan@sisd.com 98-jul-10
-
-use strict;
-use IO::File;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::Invoice;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
-
-my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum});
-die "Invoice #$invnum not found!" unless $cust_bill;
-my($custnum) = $cust_bill->getfield('custnum');
-
-my($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>
- <BR><BR>(Printed $printed times)
- </CENTER>
- <FONT SIZE=-1><PRE>
-END
-
-bless($cust_bill,"FS::Invoice");
-print $cust_bill->print_text;
-
- #formatting
- print <<END;
- </PRE></FONT>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main.cgi: View a customer
-#
-# 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
-#
-# added navigation bar (go to main menu ;)
-# ivan@voicenet.com 97-jan-30
-#
-# changes to the way credits/payments are applied (the links are here).
-# ivan@voicenet.com 97-apr-21
-#
-# added debugging code to diagnose CPU sucking problem.
-# ivan@voicenet.com 97-may-19
-#
-# CPU sucking problem was in comment code? fixed?
-# ivan@voicenet.com 97-may-22
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-22
-#
-# 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
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-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;
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header("Customer View", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <BASEFONT SIZE=3>
-END
-
-#untaint custnum & get customer record
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-die "Customer not found!" unless $cust_main;
-my($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>!;
-
-#bill now linke
-print qq!<HR><CENTER><A HREF="../misc/bill.cgi?$custnum">!,
- qq!Bill this customer now</A></CENTER>!;
-
-#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}, "!";
-}
-
-#tax
-print "<BR>(Tax exempt)" if $hashref->{tax};
-
-#otaker
-print "<P>Order taken by <B>", $hashref->{otaker}, "</B>";
-
-#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>!;
-
-#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!,
- 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!,
- qq!</FONT></TH>!,
- qq!<TH><FONT SIZE=-1>Cancel</FONT></TH>!,
- qq!</TR>\n!;
-
-#get package info
-my(@packages)=qsearch('cust_pkg',{'custnum'=>$custnum});
-my($package);
-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>";
-}
-
-#formatting
-print "</TABLE></CENTER>";
-
-#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>!;
-
-#get payment history
-#
-# major problem: this whole thing is way too sloppy.
-# minor problem: the description lines need better formatting.
-
-my(@history);
-
-my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum});
-my($bill);
-foreach $bill (@bills) {
- my($bref)=$bill->hashref;
- push @history,
- $bref->{_date} . qq!\t<A HREF="../view/cust_bill.cgi?! .
- $bref->{invnum} . qq!">Invoice #! . $bref->{invnum} .
- qq! (Balance \$! . $bref->{owed} . qq!)</A>\t! .
- $bref->{charged} . qq!\t\t\t!;
-
- 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'),
- $payment->getfield('payinfo'),
- $payment->getfield('paid'),
- );
- push @history,
- "$date\tPayment, Invoice #$invnum ($payby $payinfo)\t\t$paid\t\t";
- }
-}
-
-my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum});
-my($credit);
-foreach $credit (@credits) {
- my($cref)=$credit->hashref;
- push @history,
- $cref->{_date} . "\tCredit #" . $cref->{crednum} . ", (Balance \$" .
- $cref->{credited} . ") by " . $cref->{otaker} . " - " .
- $cref->{reason} . "\t\t\t" . $cref->{amount} . "\t";
-
- my(@refunds)=qsearch('cust_refund',{'crednum'=> $cref->{crednum} } );
- my($refund);
- foreach $refund (@refunds) {
- my($rref)=$refund->hashref;
- push @history,
- $rref->{_date} . "\tRefund, Credit #" . $rref->{crednum} . " (" .
- $rref->{payby} . " " . $rref->{payinfo} . ") by " .
- $rref->{otaker} . " - ". $rref->{reason} . "\t\t\t\t" .
- $rref->{refund};
- }
-}
-
- #formatting
- print <<END;
-<CENTER><TABLE BORDER=4>
-<TR>
- <TH>Date</TH>
- <TH>Description</TH>
- <TH><FONT SIZE=-1>Charge</FONT></TH>
- <TH><FONT SIZE=-1>Payment</FONT></TH>
- <TH><FONT SIZE=-1>In-house<BR>Credit</FONT></TH>
- <TH><FONT SIZE=-1>Refund</FONT></TH>
- <TH><FONT SIZE=-1>Balance</FONT></TH>
-</TR>
-END
-
-#display payment history
-
-my($balance)=0;
-my($item);
-foreach $item (sort keyfield_numerically @history) {
- my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item);
- $charge ||= 0;
- $payment ||= 0;
- $credit ||= 0;
- $refund ||= 0;
- $balance += $charge - $payment;
- $balance -= $credit - $refund;
-
- print "<TR><TD><FONT SIZE=-1>",time2str("%D",$date),"</FONT></TD>",
- "<TD><FONT SIZE=-1>$desc</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>\$" . sprintf("%.2f",$balance),
- "</FONT></TD>",
- "\n";
-}
-
-#formatting
-print "</TABLE></CENTER>";
-
-#end
-
-#formatting
-print <<END;
-
- </BODY>
-</HTML>
-END
-
-#subroutiens
-sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0] ; }
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pkg.cgi: View a package
-#
-# 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
-# entries in cust_pkg!
-# ivan@voicenet.com 96-dec-31
-#
-# added navigation bar
-# ivan@voicenet.com 97-jan-30
-#
-# changed and fixed up suspension and cancel stuff, now you can't add
-# services to a cancelled package
-# ivan@voicenet.com 97-feb-27
-#
-# rewrote for new API, still needs to be cleaned up!
-# ivan@voicenet.com 97-jul-29
-#
-# no FS::Search ivan@sisd.com 98-mar-7
-
-use strict;
-use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&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";
-}
-
-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;
-
-#get package record
-my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-die "No package!" unless $cust_pkg;
-my($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>!;
-
-#print info
-my($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>";
-
-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
-
- #list of services this pkgpart includes
- my($pkg_svc,%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);
- foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) {
-
- my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
-
- my(@cust_svc)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
- 'svcpart'=>$svcpart,
- });
-
- my($enum);
- for $enum ( 1 .. $pkg_svc{$svcpart} ) {
-
- my($cust_svc);
- if ( $cust_svc=shift @cust_svc ) {
- my($svcnum)=$cust_svc->svcnum;
- print <<END;
-<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc<A></TD></TR>
-END
- } else {
- print <<END;
-<TR>
- <TD><A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart">
- (Add) $svc</A>
- or <A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">
- (Link to existing) $svc</A>
- </TD>
-</TR>
-END
- }
-
- }
- warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;;
- }
-
- print "</TABLE></CENTER>";
-
-}
-
-#formatting
-print <<END;
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# View svc_acct records
-#
-# 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
-# ivan@voicenet.com 97-jan-4
-#
-# added navigation bar and ability to change username, etc.
-# ivan@voicenet.com 97-jan-30
-#
-# activate 800 service
-# ivan@voicenet.com 97-feb-10
-#
-# modified navbar code (should be a subroutine?), added link to cancel account (only if not audited)
-# ivan@voicenet.com 97-apr-16
-#
-# INCOMPLETELY rewrote some things for new API
-# ivan@voicenet.com 97-jul-29
-#
-# FS::Search became FS::Record, use strict, etc. ivan@sisd.com 98-mar-9
-#
-# 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
-#
-# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
-#
-# displays arbitrary radius attributes ivan@sisd.com 98-aug-16
-
-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;
-&cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($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);
-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>Account View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Account View</H1>
- <BASEFONT SIZE=3>
-<CENTER>
-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
-}
-
-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
-if (substr($svc_acct->_password,0,1) eq "*") {
- print "<BR>Password: <I>(Login disabled)</I><BR>";
-} else {
- print "<BR>Password: <I>(hidden)</I><BR>";
-}
-
-# 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->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>";
-} else {
- print "No shell account.</A></FONT></CENTER>";
-}
-
-# 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>";
- my($attribute);
- foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
- #warn $attribute;
- $attribute =~ /^radius_(.*)$/;
- my($pattribute) = ($1);
- $pattribute =~ s/_/-/g;
- print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>";
- }
-} else {
- print "No SLIP/PPP account</A></FONT></CENTER>"
-}
-
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# View svc_acct_sm records
-#
-# 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
-#
-# added navigation bar
-# ivan@voicenet.com 97-jan-30
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-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;
-cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($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);
-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
-}
-
-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
-
-my($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
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# View svc_domain records
-#
-# 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
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($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);
-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>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
-
--- /dev/null
+use strict;
+use vars qw( $cgi $p );
+use CGI;
+#use CGI::Carp qw(fatalsToBrowser);
+use Date::Format;
+use Date::Parse;
+use Tie::IxHash;
+use HTML::Entities;
+use IO::Handle;
+use IO::File;
+use String::Approx qw(amatch);
+use HTML::Widgets::SelectLayers 0.02;
+use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
+use FS::Record qw(qsearch qsearchs fields dbdef);
+use FS::Conf;
+use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
+ small_custview myexit);
+use FS::Msgcat qw(gettext geterror);
+
+use FS::agent;
+use FS::agent_type;
+use FS::domain_record;
+use FS::cust_bill;
+use FS::cust_bill_pay;
+use FS::cust_credit;
+use FS::cust_credit_bill;
+use FS::cust_main;
+use FS::cust_main_county;
+use FS::cust_pay;
+use FS::cust_pkg;
+use FS::cust_refund;
+use FS::cust_svc;
+use FS::nas;
+use FS::part_bill_event;
+use FS::part_pkg;
+use FS::part_referral;
+use FS::part_svc;
+use FS::pkg_svc;
+use FS::port;
+use FS::queue qw(joblisting);
+use FS::raddb;
+use FS::session;
+use FS::svc_acct;
+use FS::svc_acct_pop qw(popselector);
+use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::svc_forward;
+use FS::svc_www;
+use FS::type_pkgs;
+use FS::part_export;
+use FS::part_export_option;
+use FS::export_svc;
+use FS::msgcat;
+
+sub Script_OnStart {
+ $Response->AddHeader('Pragma' => 'no-cache');
+ $Response->AddHeader('Cache-control' => 'no-cache');
+# $Response->AddHeader('Expires' => 0);
+ $Response->{Expires} = -36288000;
+
+ $cgi = new CGI;
+ &cgisuidsetup($cgi);
+ $p = popurl(2);
+ #print $cgi->header( '-expires' => 'now' );
+}
+
+sub Script_OnFlush {
+ my $ref = $Response->{BinaryRef};
+ $$ref = $cgi->header( @FS::CGI::header ) . $$ref;
+ if ( dbh->can('sprintProfile') ) {
+
+ $$ref =~ s/<\/BODY>[\s\n]*<\/HTML>[\s\n]*$//i
+ or warn "can't remove";
+
+ #$$ref .= '<PRE>'. ("\n"x96). encode_entities(dbh->sprintProfile()). '</PRE>';
+ # wtf? konqueror...
+ $$ref .= '<PRE>'. ("\n"x4096). encode_entities(dbh->sprintProfile()). '</PRE>';
+
+ $$ref .= '</BODY></HTML>';
+
+ dbh->{'private_profile'} = {};
+ }
+}
--- /dev/null
+#!/usr/bin/perl
+#
+# This is a basic, fairly fuctional Mason handler.pl.
+#
+# For something a little more involved, check out session_handler.pl
+
+package HTML::Mason;
+
+# Bring in main Mason package.
+use HTML::Mason;
+
+# Bring in ApacheHandler, necessary for mod_perl integration.
+# Uncomment the second line (and comment the first) to use
+# Apache::Request instead of CGI.pm to parse arguments.
+use HTML::Mason::ApacheHandler;
+# use HTML::Mason::ApacheHandler (args_method=>'mod_perl');
+
+# Uncomment the next line if you plan to use the Mason previewer.
+#use HTML::Mason::Preview;
+
+use strict;
+
+# List of modules that you want to use from components (see Admin
+# manual for details)
+#{ package HTML::Mason::Commands;
+# use CGI;
+#}
+
+# Create Mason objects
+#
+my $parser = new HTML::Mason::Parser;
+my $interp = new HTML::Mason::Interp (parser=>$parser,
+ comp_root=>'/var/www/masondocs',
+ data_dir=>'/home/ivan/freeside_current/masondata',
+ out_mode=>'stream',
+ );
+my $ah = new HTML::Mason::ApacheHandler ( interp => $interp,
+ #auto_send_headers => 0,
+ );
+
+# Activate the following if running httpd as root (the normal case).
+# Resets ownership of all files created by Mason at startup.
+#
+chown (Apache->server->uid, Apache->server->gid, $interp->files_written);
+
+sub handler
+{
+ my ($r) = @_;
+
+ # If you plan to intermix images in the same directory as
+ # components, activate the following to prevent Mason from
+ # evaluating image files as components.
+ #
+ #return -1 if $r->content_type && $r->content_type !~ m|^text/|i;
+
+ #rar
+ { package HTML::Mason::Commands;
+ use strict;
+ use vars qw( $cgi $p );
+ use CGI;
+ #use CGI::Carp qw(fatalsToBrowser);
+ use Date::Format;
+ use Date::Parse;
+ use Tie::IxHash;
+ use HTML::Entities;
+ use IO::Handle;
+ use IO::File;
+ use String::Approx qw(amatch);
+ use HTML::Widgets::SelectLayers 0.02;
+ use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name);
+ use FS::Record qw(qsearch qsearchs fields dbdef);
+ use FS::Conf;
+ use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot
+ small_custview myexit);
+ use FS::Msgcat qw(gettext geterror);
+
+ use FS::agent;
+ use FS::agent_type;
+ use FS::domain_record;
+ use FS::cust_bill;
+ use FS::cust_bill_pay;
+ use FS::cust_credit;
+ use FS::cust_credit_bill;
+ use FS::cust_main;
+ use FS::cust_main_county;
+ use FS::cust_pay;
+ use FS::cust_pkg;
+ use FS::cust_refund;
+ use FS::cust_svc;
+ use FS::nas;
+ use FS::part_bill_event;
+ use FS::part_pkg;
+ use FS::part_referral;
+ use FS::part_svc;
+ use FS::pkg_svc;
+ use FS::port;
+ use FS::queue qw(joblisting);
+ use FS::raddb;
+ use FS::session;
+ use FS::svc_acct;
+ use FS::svc_acct_pop qw(popselector);
+ use FS::svc_acct_sm;
+ use FS::svc_domain;
+ use FS::svc_forward;
+ use FS::svc_www;
+ use FS::type_pkgs;
+ use FS::part_export;
+ use FS::part_export_option;
+ use FS::export_svc;
+ use FS::msgcat;
+
+ *CGI::redirect = sub {
+ my( $self, $location ) = @_;
+
+ #http://www.masonhq.com/docs/faq/#how_do_i_do_an_external_redirect
+ $m->clear_buffer;
+ # The next two lines are necessary to stop Apache from re-reading
+ # POSTed data.
+ $r->method('GET');
+ $r->headers_in->unset('Content-length');
+ $r->content_type('text/html');
+ #$r->err_header_out('Location' => $location);
+ $r->header_out('Location' => $location);
+ $r->header_out('Content-Type' => 'text/html');
+ $m->abort(302);
+
+ '';
+ };
+
+ $cgi = new CGI;
+ &cgisuidsetup($cgi);
+ #&cgisuidsetup($r);
+ $p = popurl(2);
+ }
+
+ $r->content_type('text/html');
+ #eorar
+
+ my $headers = $r->headers_out;
+ $headers->{'Pragma'} = $headers->{'Cache-control'} = 'no-cache';
+ #$r->no_cache(1);
+ $headers->{'Expires'} = '0';
+
+# $r->send_http_header;
+
+ my $status = $ah->handle_request($r);
+
+ $status;
+}
+
+1;
--- /dev/null
+AuthName Freeside
+AuthType Basic
+require valid-user
--- /dev/null
+<!-- mason kludge -->
+<%
+
+#Begin silliness
+#
+#use FS::UI::CGI;
+#use FS::UI::agent;
+#
+#$ui = new FS::UI::agent;
+#$ui->browse;
+#exit;
+#__END__
+#End silliness
+
+print header('Agent Listing', menubar(
+ 'Main Menu' => $p,
+ 'Agent Types' => $p. 'browse/agent_type.cgi',
+# 'Add new agent' => '../edit/agent.cgi'
+)), <<END;
+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 COLSPAN=2>Agent</TH>
+ <TH>Type</TH>
+ <TH><FONT SIZE=-1>Freq.</FONT></TH>
+ <TH><FONT SIZE=-1>Prog.</FONT></TH>
+ </TR>
+END
+# <TH><FONT SIZE=-1>Agent #</FONT></TH>
+# <TH>Agent</TH>
+
+foreach my $agent ( sort {
+ #$a->getfield('agentnum') <=> $b->getfield('agentnum')
+ $a->getfield('agent') cmp $b->getfield('agent')
+} qsearch('agent',{}) ) {
+ my($hashref)=$agent->hashref;
+ my($typenum)=$hashref->{typenum};
+ my($agent_type)=qsearchs('agent_type',{'typenum'=>$typenum});
+ my($atype)=$agent_type->getfield('atype');
+ print <<END;
+ <TR>
+ <TD><A HREF="${p}edit/agent.cgi?$hashref->{agentnum}">
+ $hashref->{agentnum}</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>
+END
+
+}
+
+print <<END;
+ <TR>
+ <TD COLSPAN=2><A HREF="${p}edit/agent.cgi"><I>Add a new agent</I></A></TD>
+ <TD><A HREF="${p}edit/agent_type.cgi"><I>Add a new agent type</I></A></TD>
+ </TR>
+ </TABLE>
+
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print 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 COLSPAN=2>Agent Type</TH>
+ <TH COLSPAN=2>Packages</TH>
+ </TR>
+END
+
+foreach my $agent_type ( sort {
+ $a->getfield('typenum') <=> $b->getfield('typenum')
+} qsearch('agent_type',{}) ) {
+ my($hashref)=$agent_type->hashref;
+ my(@type_pkgs)=qsearch('type_pkgs',{'typenum'=> $hashref->{typenum} });
+ my($rowspan)=scalar(@type_pkgs);
+ $rowspan = int($rowspan/2+0.5) ;
+ print <<END;
+ <TR>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">
+ $hashref->{typenum}
+ </A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/agent_type.cgi?$hashref->{typenum}">$hashref->{atype}</A></TD>
+END
+
+ my($type_pkgs);
+ my($tdcount) = -1 ;
+ foreach $type_pkgs ( @type_pkgs ) {
+ my($pkgpart)=$type_pkgs->getfield('pkgpart');
+ my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart });
+ print qq!<TR>! if ($tdcount == 0) ;
+ $tdcount = 0 if ($tdcount == -1) ;
+ print qq!<TD><A HREF="${p}edit/part_pkg.cgi?$pkgpart">!,
+ $part_pkg->getfield('pkg'),"</A></TD>";
+ $tdcount ++ ;
+ if ($tdcount == 2)
+ {
+ print qq!</TR>\n! ;
+ $tdcount = 0 ;
+ }
+ }
+
+ print "</TR>";
+}
+
+print <<END;
+ <TR><TD COLSPAN=4><I><A HREF="${p}edit/agent_type.cgi">Add a new agent type</A></I></TD></TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $enable_taxclasses = $conf->exists('enable_taxclasses');
+
+print header("Tax Rate Listing", menubar(
+ 'Main Menu' => $p,
+ 'Edit tax rates' => $p. "edit/cust_main_county.cgi",
+)),<<END;
+ 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.
+END
+
+if ( $enable_taxclasses ) {
+ print '<BR>Click on <u>expand taxclasses</u> to specify tax classes';
+}
+
+print '<BR><BR>'. &table(). <<END;
+ <TR>
+ <TH><FONT SIZE=-1>Country</FONT></TH>
+ <TH><FONT SIZE=-1>State</FONT></TH>
+ <TH>County</TH>
+ <TH>Taxclass</TH>
+ <TH><FONT SIZE=-1>Tax</FONT></TH>
+ <TH><FONT SIZE=-1>Exempt<BR>per<BR>month</TH>
+ </TR>
+END
+
+my @regions = sort { $a->country cmp $b->country
+ or $a->state cmp $b->state
+ or $a->county cmp $b->county
+ or $a->taxclass cmp $b->taxclass
+ } qsearch('cust_main_county',{});
+
+my $sup=0;
+#foreach $cust_main_county ( @regions ) {
+for ( my $i=0; $i<@regions; $i++ ) {
+ my $cust_main_county = $regions[$i];
+ my $hashref = $cust_main_county->hashref;
+ print <<END;
+ <TR>
+ <TD BGCOLOR="#ffffff">$hashref->{country}</TD>
+END
+
+ my $j;
+ if ( $sup ) {
+ $sup--;
+ } else {
+
+ #lookahead
+ for ( $j=1; $i+$j<@regions; $j++ ) {
+ last if $hashref->{country} ne $regions[$i+$j]->country
+ || $hashref->{state} ne $regions[$i+$j]->state
+ || $hashref->{tax} != $regions[$i+$j]->tax
+ || $hashref->{exempt_amount} != $regions[$i+$j]->exempt_amount;
+ }
+
+ my $newsup=0;
+ if ( $j>1 && $i+$j+1 < @regions
+ && ( $hashref->{state} ne $regions[$i+$j+1]->state
+ || $hashref->{country} ne $regions[$i+$j+1]->country
+ )
+ && ( ! $i
+ || $hashref->{state} ne $regions[$i-1]->state
+ || $hashref->{country} ne $regions[$i-1]->country
+ )
+ ) {
+ $sup = $j-1;
+ } else {
+ $j = 1;
+ }
+
+ print "<TD ROWSPAN=$j", $hashref->{state}
+ ? ' BGCOLOR="#ffffff">'. $hashref->{state}
+ : qq! BGCOLOR="#cccccc">(ALL) <FONT SIZE=-1>!.
+ qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
+ qq!">expand country</A></FONT>!;
+
+ print qq! <FONT SIZE=-1><A HREF="${p}edit/process/cust_main_county-collapse.cgi?!. $hashref->{taxnum}. qq!">collapse state</A></FONT>! if $j>1;
+
+ print "</TD>";
+ }
+
+# $sup=$newsup;
+
+ print "<TD";
+ if ( $hashref->{county} ) {
+ print ' BGCOLOR="#ffffff">'. $hashref->{county};
+ } else {
+ print ' BGCOLOR="#cccccc">(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 "<TD";
+ if ( $hashref->{taxclass} ) {
+ print ' BGCOLOR="#ffffff">'. $hashref->{taxclass};
+ } else {
+ print ' BGCOLOR="#cccccc">(ALL)';
+ if ( $enable_taxclasses ) {
+ print qq!<FONT SIZE=-1>!.
+ qq!<A HREF="${p}edit/cust_main_county-expand.cgi?taxclass!.
+ $hashref->{taxnum}. qq!">expand taxclasses</A></FONT>!;
+ }
+
+ }
+ print "</TD>";
+
+ print "<TD BGCOLOR=\"#ffffff\">$hashref->{tax}%</TD>".
+ '<TD BGCOLOR="#ffffff">$'.
+ sprintf("%.2f", $hashref->{exempt_amount} || 0). '</TD>'.
+ '</TR>';
+
+}
+
+print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header("Pending credit card batch", menubar(
+ 'Main Menu' => $p,
+# 'Add new referral' => "../edit/part_referral.cgi",
+)), &table(), <<END;
+ <TR>
+ <TH>#</TH>
+ <TH><font size=-1>inv#</font></TH>
+ <TH COLSPAN=2>Customer</TH>
+ <TH>Card name</TH>
+ <TH>Card</TH>
+ <TH>Exp</TH>
+ <TH>Amount</TH>
+ </TR>
+END
+
+foreach my $cust_pay_batch ( sort {
+ $a->getfield('paybatchnum') <=> $b->getfield('paybatchnum')
+} qsearch('cust_pay_batch',{}) ) {
+# my $date = time2str( "%a %b %e %T %Y", $queue->_date );
+# my $status = $hashref->{status};
+# if ( $status eq 'failed' || $status eq 'locked' ) {
+# $status .=
+# qq! ( <A HREF="$p/edit/cust_pay_batch.cgi?jobnum=$jobnum&action=new">retry</A> |!.
+# qq! <A HREF="$p/edit/cust_pay_batch.cgi?jobnum$jobnum&action=del">remove </A> )!;
+# }
+ my $cardnum = $cust_pay_batch->{cardnum};
+ $cardnum =~ s/.{4}$/xxxx/;
+ print <<END;
+ <TR>
+ <TD>$cust_pay_batch->{paybatchnum}</TD>
+ <TD><A HREF="../view/cust_bill.cgi?$cust_pay_batch->{invnum}">$cust_pay_batch->{invnum}</TD>
+ <TD><A HREF="../view/cust_main.cgi?$cust_pay_batch->{custnum}">$cust_pay_batch->{custnum}</TD>
+ <TD>$cust_pay_batch->{last}, $cust_pay_batch->{last}</TD>
+ <TD>$cust_pay_batch->{payname}</TD>
+ <TD>$cardnum</TD>
+ <TD>$cust_pay_batch->{exp}</TD>
+ <TD align="right">\$$cust_pay_batch->{amount}</TD>
+ </TR>
+END
+
+}
+
+print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header("View Message catalog", menubar(
+ 'Main Menu' => $p,
+ 'Edit message catalog' => $p. "edit/msgcat.cgi",
+)), '<BR>';
+
+my $widget = new HTML::Widgets::SelectLayers(
+ 'selected_layer' => 'en_US',
+ 'options' => { 'en_US'=>'en_US' },
+ 'layer_callback' => sub {
+ my $layer = shift;
+ my $html = "<BR>Messages for locale $layer<BR>". table().
+ "<TR><TH COLSPAN=2>Code</TH>".
+ "<TH>Message</TH>";
+ $html .= "<TH>en_US Message</TH>" unless $layer eq 'en_US';
+ $html .= '</TR>';
+
+ #foreach my $msgcat ( sort { $a->msgcode cmp $b->msgcode }
+ # qsearch('msgcat', { 'locale' => $layer } ) ) {
+ foreach my $msgcat ( qsearch('msgcat', { 'locale' => $layer } ) ) {
+ $html .= '<TR><TD>'. $msgcat->msgnum. '</TD>'.
+ '<TD>'. $msgcat->msgcode. '</TD>'.
+ '<TD>'. $msgcat->msg. '</TD>';
+ unless ( $layer eq 'en_US' ) {
+ my $en_msgcat = qsearchs('msgcat', {
+ 'locale' => 'en_US',
+ 'msgcode' => $msgcat->msgcode,
+ } );
+ $html .= '<TD>'. $en_msgcat->msg. '</TD>';
+ }
+ $html .= '</TR>';
+ }
+
+ $html .= '</TABLE>';
+ $html;
+ },
+
+);
+
+print $widget->html;
+
+print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header('NAS ports', menubar(
+ 'Main Menu' => $p,
+));
+
+my $now = time;
+
+foreach my $nas ( sort { $a->nasnum <=> $b->nasnum } qsearch( 'nas', {} ) ) {
+ print $nas->nasnum. ": ". $nas->nas. " ".
+ $nas->nasfqdn. " (". $nas->nasip. ") ".
+ "as of ". time2str("%c",$nas->last).
+ " (". &pretty_interval($now - $nas->last). " ago)<br>".
+ &table(). "<TR><TH>Nas<BR>Port #</TH><TH>Global<BR>Port #</BR></TH>".
+ "<TH>IP address</TH><TH>User</TH><TH>Since</TH><TH>Duration</TH><TR>",
+ ;
+ foreach my $port ( sort {
+ $a->nasport <=> $b->nasport || $a->portnum <=> $b->portnum
+ } qsearch( 'port', { 'nasnum' => $nas->nasnum } ) ) {
+ my $session = $port->session;
+ my($user, $since, $pretty_since, $duration);
+ if ( ! $session ) {
+ $user = "(empty)";
+ $since = 0;
+ $pretty_since = "(never)";
+ $duration = '';
+ } elsif ( $session->logout ) {
+ $user = "(empty)";
+ $since = $session->logout;
+ } else {
+ my $svc_acct = $session->svc_acct;
+ $user = "<A HREF=\"$p/view/svc_acct.cgi?". $svc_acct->svcnum. "\">".
+ $svc_acct->username. "</A>";
+ $since = $session->login;
+ }
+ $pretty_since = time2str("%c", $since) if $since;
+ $duration = pretty_interval( $now - $since ). " ago"
+ unless defined($duration);
+ print "<TR><TD>". $port->nasport. "</TD><TD>". $port->portnum. "</TD><TD>".
+ $port->ip. "</TD><TD>$user</TD><TD>$pretty_since".
+ "</TD><TD>$duration</TD></TR>"
+ ;
+ }
+ print "</TABLE><BR>";
+}
+
+#Time::Duration??
+sub pretty_interval {
+ my $interval = shift;
+ my %howlong = (
+ '604800' => 'week',
+ '86400' => 'day',
+ '3600' => 'hour',
+ '60' => 'minute',
+ '1' => 'second',
+ );
+
+ my $pretty = "";
+ foreach my $key ( sort { $b <=> $a } keys %howlong ) {
+ my $value = int( $interval / $key );
+ if ( $value ) {
+ if ( $value == 1 ) {
+ $pretty .=
+ ( $howlong{$key} eq 'hour' ? 'an ' : 'a ' ). $howlong{$key}. " "
+ } else {
+ $pretty .= $value. ' '. $howlong{$key}. 's ';
+ }
+ }
+ $interval -= $value * $key;
+ }
+ $pretty =~ /^\s*(\S.*\S)\s*$/;
+ $1;
+}
+
+#print &table(), <<END;
+#<TR>
+# <TH>#</TH>
+# <TH>NAS</
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my %search;
+if ( $cgi->param('showdisabled') ) {
+ %search = ();
+} else {
+ %search = ( 'disabled' => '' );
+}
+
+my @part_bill_event = qsearch('part_bill_event', \%search );
+my $total = scalar(@part_bill_event);
+
+%>
+<%= header('Invoice Event Listing', menubar( 'Main Menu' => $p) ) %>
+
+ Invoice events are actions taken on overdue invoices.<BR><BR>
+<%= $total %> events
+<%= $cgi->param('showdisabled')
+ ? do { $cgi->param('showdisabled', 0);
+ '( <a href="'. $cgi->self_url. '">hide disabled events</a> )'; }
+ : do { $cgi->param('showdisabled', 1);
+ '( <a href="'. $cgi->self_url. '">show disabled events</a> )'; }
+%>
+<%= table() %>
+ <TR>
+ <TH COLSPAN=<%= $cgi->param('showdisabled') ? 2 : 3 %>>Event</TH>
+ <TH>Payby</TH>
+ <TH>After</TH>
+ <TH>Action</TH>
+ <TH>Options</TH>
+ <TH>Code</TH>
+ </TR>
+
+<% foreach my $part_bill_event ( sort { $a->payby cmp $b->payby
+ || $a->seconds <=> $b->seconds
+ || $a->weight <=> $b->weight
+ || $a->eventpart <=> $b->eventpart
+ } @part_bill_event ) {
+ my $url = "${p}edit/part_bill_event.cgi?". $part_bill_event->eventpart;
+ use Time::Duration;
+ my $delay = duration_exact($part_bill_event->seconds);
+ my $plandata = $part_bill_event->plandata;
+ $plandata =~ s/\n/<BR>/go;
+%>
+ <TR>
+ <TD><A HREF="<%= $url %>">
+ <%= $part_bill_event->eventpart %></A></TD>
+<% unless ( $cgi->param('showdisabled') ) { %>
+ <TD>
+ <%= $part_bill_event->disabled ? 'DISABLED' : '' %></TD>
+<% } %>
+ <TD><A HREF="<%= $url %>">
+ <%= $part_bill_event->event %></A></TD>
+ <TD>
+ <%= $part_bill_event->payby %></TD>
+ <TD>
+ <%= $delay %></TD>
+ <TD>
+ <%= $part_bill_event->plan %></TD>
+ <TD>
+ <%= $plandata %></TD>
+ <TD><FONT SIZE="-1">
+ <%= $part_bill_event->eventcode %></FONT></TD>
+ </TR>
+<% } %>
+
+ <TR>
+ <TD COLSPAN=8><A HREF="<%= $p %>edit/part_bill_event.cgi"><I>Add a new invoice event</I></A></TD>
+ </TR>
+</TABLE>
+</BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%= header("Export Listing", menubar( 'Main Menu' => $p )) %>
+Provisioning services to external machines, databases and APIs.<BR><BR>
+
+<SCRIPT>
+function part_export_areyousure(href) {
+ if (confirm("Are you sure you want to delete this export?") == true)
+ window.location.href = href;
+}
+</SCRIPT>
+
+<%= table() %>
+ <TR>
+ <TH COLSPAN=2>Export</TH>
+ <TH>Options</TH>
+ </TR>
+
+<% foreach my $part_export ( sort {
+ $a->getfield('exportnum') <=> $b->getfield('exportnum')
+ } qsearch('part_export',{}) ) {
+%>
+ <TR>
+ <TD><A HREF="<%= $p %>edit/part_export.cgi?<%= $part_export->exportnum %>"><%= $part_export->exportnum %></A></TD>
+ <TD><%= $part_export->exporttype %> to <%= $part_export->machine %> (<A HREF="<%= $p %>edit/part_export.cgi?<%= $part_export->exportnum %>">edit</A> | <A HREF="javascript:part_export_areyousure('<%= $p %>misc/delete-part_export.cgi?<%= $part_export->exportnum %>')">delete</A>)</TD>
+ <TD>
+ <%= itable() %>
+ <% my %opt = $part_export->options;
+ foreach my $opt ( keys %opt ) { %>
+ <TR><TD><%= $opt %></TD><TD><%= $opt{$opt} %></TD></TR>
+ <% } %>
+ </TABLE>
+ </TD>
+ </TR>
+
+<% } %>
+
+ <TR>
+ <TD COLSPAN=3><A HREF="<%= $p %>edit/part_export.cgi"><I>Add a new export</I></A></TD>
+ </TR>
+</TABLE>
+</BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my %search;
+if ( $cgi->param('showdisabled') ) {
+ %search = ();
+} else {
+ %search = ( 'disabled' => '' );
+}
+
+my @part_pkg = qsearch('part_pkg', \%search );
+my $total = scalar(@part_pkg);
+
+print header("Package Definition Listing",menubar(
+ 'Main Menu' => $p,
+)). "One or more services are grouped together into a package and given".
+ " pricing information. Customers purchase packages".
+ " rather than purchase services directly.<BR><BR>".
+ "$total packages ";
+
+if ( $cgi->param('showdisabled') ) {
+ $cgi->param('showdisabled', 0);
+ print qq!( <a href="!. $cgi->self_url. qq!">hide disabled packages</a> )!;
+} else {
+ $cgi->param('showdisabled', 1);
+ print qq!( <a href="!. $cgi->self_url. qq!">show disabled packages</a> )!;
+}
+
+my $colspan = $cgi->param('showdisabled') ? 2 : 3;
+print &table(), <<END;
+ <TR>
+ <TH COLSPAN=$colspan>Package</TH>
+ <TH>Comment</TH>
+ <TH><FONT SIZE=-1>Freq.</FONT></TH>
+ <TH><FONT SIZE=-1>Plan</FONT></TH>
+ <TH><FONT SIZE=-1>Data</FONT></TH>
+ <TH>Service</TH>
+ <TH><FONT SIZE=-1>Quan.</FONT></TH>
+ </TR>
+END
+
+foreach my $part_pkg ( sort {
+ $a->getfield('pkgpart') <=> $b->getfield('pkgpart')
+} @part_pkg ) {
+ my($hashref)=$part_pkg->hashref;
+ my(@pkg_svc)=grep $_->getfield('quantity'),
+ qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} });
+ my($rowspan)=scalar(@pkg_svc);
+ my $plandata;
+ if ( $hashref->{plan} ) {
+ $plandata = $hashref->{plandata};
+ $plandata =~ s/^(\w+)=/$1 /mg;
+ $plandata =~ s/\n/<BR>/g;
+ } else {
+ $hashref->{plan} = "(legacy)";
+ $plandata = "Setup ". $hashref->{setup}.
+ "<BR>Recur ". $hashref->{recur};
+ }
+ print <<END;
+ <TR>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkgpart}</A></TD>
+END
+
+ unless ( $cgi->param('showdisabled') ) {
+ print "<TD ROWSPAN=$rowspan>";
+ print "DISABLED" if $hashref->{disabled};
+ print '</TD>';
+ }
+
+ print <<END;
+ <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->{freq}</TD>
+ <TD ROWSPAN=$rowspan>$hashref->{plan}</TD>
+ <TD ROWSPAN=$rowspan>$plandata</TD>
+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 $n,qq!<TD><A HREF="${p}edit/part_svc.cgi?$svcpart">!,
+ $part_svc->getfield('svc'),"</A></TD><TD>",
+ $pkg_svc->getfield('quantity'),"</TD></TR>\n";
+ $n="<TR>";
+ }
+
+ print "</TR>";
+}
+
+$colspan = $cgi->param('showdisabled') ? 8 : 9;
+print <<END;
+ <TR><TD COLSPAN=$colspan><I><A HREF="${p}edit/part_pkg.cgi">Add a new package definition</A></I></TD></TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header("Advertising source 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 COLSPAN=2>Advertising source</TH>
+ </TR>
+END
+
+foreach my $part_referral ( sort {
+ $a->getfield('refnum') <=> $b->getfield('refnum')
+} qsearch('part_referral',{}) ) {
+ my($hashref)=$part_referral->hashref;
+ print <<END;
+ <TR>
+ <TD><A HREF="${p}edit/part_referral.cgi?$hashref->{refnum}">
+ $hashref->{refnum}</A></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 a new advertising source</I></A></TD>
+ </TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my %search;
+if ( $cgi->param('showdisabled') ) {
+ %search = ();
+} else {
+ %search = ( 'disabled' => '' );
+}
+
+my @part_svc =
+ sort { $a->getfield('svcpart') <=> $b->getfield('svcpart') }
+ qsearch('part_svc', \%search );
+my $total = scalar(@part_svc);
+
+%>
+<%= header('Service Definition Listing', menubar( 'Main Menu' => $p) ) %>
+
+<SCRIPT>
+function part_export_areyousure(href) {
+ if (confirm("Are you sure you want to delete this export?") == true)
+ window.location.href = href;
+}
+</SCRIPT>
+
+ Services are items you offer to your customers.<BR><BR>
+<%= $total %> services
+<%= $cgi->param('showdisabled')
+ ? do { $cgi->param('showdisabled', 0);
+ '( <a href="'. $cgi->self_url. '">hide disabled services</a> )'; }
+ : do { $cgi->param('showdisabled', 1);
+ '( <a href="'. $cgi->self_url. '">show disabled services</a> )'; }
+%>
+<%= table() %>
+ <TR>
+ <TH COLSPAN=<%= $cgi->param('showdisabled') ? 2 : 3 %>>Service</TH>
+ <TH>Table</TH>
+ <TH>Export</TH>
+ <TH>Field</TH>
+ <TH COLSPAN=2>Modifier</TH>
+ </TR>
+
+<% foreach my $part_svc ( @part_svc ) {
+ my $hashref = $part_svc->hashref;
+ my $svcdb = $hashref->{svcdb};
+ my @dfields = fields($svcdb);
+ push @dfields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
+ my @fields =
+ grep { $_ ne 'svcnum' && $part_svc->part_svc_column($_)->columnflag }
+ @dfields;
+
+ my $rowspan = scalar(@fields) || 1;
+ my $url = "${p}edit/part_svc.cgi?$hashref->{svcpart}";
+%>
+
+ <TR>
+ <TD ROWSPAN=<%= $rowspan %>><A HREF="<%= $url %>">
+ <%= $hashref->{svcpart} %></A></TD>
+<% unless ( $cgi->param('showdisabled') ) { %>
+ <TD ROWSPAN=<%= $rowspan %>>
+ <%= $hashref->{disabled} ? 'DISABLED' : '' %></TD>
+<% } %>
+ <TD ROWSPAN=<%= $rowspan %>><A HREF="<%= $url %>">
+ <%= $hashref->{svc} %></A></TD>
+ <TD ROWSPAN=<%= $rowspan %>>
+ <%= $hashref->{svcdb} %></TD>
+ <TD ROWSPAN=<%= $rowspan %>><%= itable() %>
+<%
+# my @part_export =
+map { qsearchs('part_export', { exportnum => $_->exportnum } ) } qsearch('export_svc', { svcpart => $part_svc->svcpart } ) ;
+ foreach my $part_export (
+ map { qsearchs('part_export', { exportnum => $_->exportnum } ) }
+ qsearch('export_svc', { svcpart => $part_svc->svcpart } )
+ ) {
+%>
+ <TR>
+ <TD><A HREF="<%= $p %>edit/part_export.cgi?<%= $part_export->exportnum %>"><%= $part_export->exporttype %> to <%= $part_export->machine %></A></TD></TR>
+<% } %>
+ </TABLE></TD>
+
+<% my($n1)='';
+ foreach my $field ( @fields ) {
+ my $flag = $part_svc->part_svc_column($field)->columnflag;
+%>
+ <%= $n1 %><TD><%= $field %></TD><TD>
+
+<% if ( $flag eq "D" ) { print "Default"; }
+ elsif ( $flag eq "F" ) { print "Fixed"; }
+ else { print "(Unknown!)"; }
+%>
+ </TD><TD><%= $part_svc->part_svc_column($field)->columnvalue%></TD>
+<% $n1="</TR><TR>";
+ }
+%>
+ </TR>
+<% } %>
+
+ <TR>
+ <TD COLSPAN=<%= $cgi->param('showdisabled') ? 7 : 8 %>>
+ <FORM METHOD="POST" ACTION="<%= $p %>edit/part_svc.cgi"><A HREF="<%= $p %>edit/part_svc.cgi"><I>Add a new service definition</I></A> or <SELECT NAME="clone"><OPTION></OPTION>
+<% foreach my $part_svc ( @part_svc ) { %>
+ <OPTION VALUE="<%= $part_svc->svcpart %>"><%= $part_svc->svc %></OPTION>
+<% } %>
+ </SELECT><INPUT TYPE="submit" VALUE="Clone existing service">
+ </FORM>
+ </TD>
+ </TR>
+</TABLE>
+</BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header("Job Queue", menubar( 'Main Menu' => $p, )).
+ joblisting({}). '</BODY></HTML>';
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header('Access Number Listing', menubar(
+ 'Main Menu' => $p,
+)), "Points of Presence<BR><BR>", &table(), <<END;
+ <TR>
+ <TH></TH>
+ <TH>City</TH>
+ <TH>State</TH>
+ <TH>Area code</TH>
+ <TH>Exchange</TH>
+ <TH>Local</TH>
+ </TR>
+END
+
+foreach my $svc_acct_pop ( sort {
+ #$a->getfield('popnum') <=> $b->getfield('popnum')
+ $a->state cmp $b->state || $a->city cmp $b->city
+ || $a->ac <=> $b->ac || $a->exch <=> $b->exch || $a->loc <=> $b->loc
+} qsearch('svc_acct_pop',{}) ) {
+ my($hashref)=$svc_acct_pop->hashref;
+ print <<END;
+ <TR>
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ $hashref->{popnum}</A></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>
+ <TD><A HREF="${p}edit/svc_acct_pop.cgi?$hashref->{popnum}">
+ $hashref->{loc}</A></TD>
+ </TR>
+END
+
+}
+
+print <<END;
+ <TR>
+ <TD COLSPAN=5><A HREF="${p}edit/svc_acct_pop.cgi"><I>Add new Access Number</I></A></TD>
+ </TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>
+ Freeside Main Menu
+ </TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#FFFFFF">
+ <table width="100%">
+ <tr><td>
+ <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.png">
+ </td><td>
+ <font color="#ff0000" size=7>freeside main menu</font>
+ </td><td align=right valign=bottom>
+ version 1.4.0
+ <BR><A HREF="http://www.sisd.com/freeside">Freeside home page</A>
+ <BR><A HREF="docs/">Documentation</A>
+ <BR><A HREF="index.html">New interface</A>
+ </td></tr>
+ </table>
+ <hr noshade>
+ <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>
+ <LI><A HREF="search/cust_main-payinfo.html">customers (by credit card number)</A>
+ <LI><A HREF="search/svc_acct.html">accounts (by username)</A>
+ <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/svc_forward.html">mail forwards (by ?)</A>-->
+ <LI><A HREF="search/cust_bill.html">invoices (by invoice number)</A>
+ <LI><A HREF="search/cust_pay.html">checks (by check number)</A>
+ </ul>
+ <li><A NAME="browse">Browse</A>
+ <ul>
+ <LI>customers (<A HREF="search/cust_main.cgi?browse=custnum">by customer number</A>) (<A HREF="search/cust_main.cgi?browse=last">by last name</A>) (<A HREF="search/cust_main.cgi?browse=company">by company</A>)
+ <LI>invoices
+ <UL>
+ <LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>)
+ <LI>30 day open invoices (<A HREF="search/cust_bill.cgi?OPEN30_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN30_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN30_custnum">by customer number</A>)
+ <LI>60 day open invoices (<A HREF="search/cust_bill.cgi?OPEN60_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN60_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN60_custnum">by customer number</A>)
+ <LI>90 day open invoices (<A HREF="search/cust_bill.cgi?OPEN90_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN90_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN90_custnum">by customer number</A>)
+ <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>)
+ <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>)
+ </UL>
+ <LI>financials
+ <UL>
+ <LI><A HREF="search/report_receivables.cgi">receivables report</A>
+ <LI><A HREF="search/report_tax.html">tax reports</A>
+ <LI><A HREF="search/report_cc.html">credit card receipts</A>
+ <LI><A HREF="search/report_credit.html">in house credits</A>
+ </UL>
+ <LI>packages
+ <UL>
+ <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
+ <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
+ </UL>
+ <LI>services
+ <UL>
+ <LI>accounts (<A HREF="search/svc_acct.cgi?svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?username">by username</A>) (<A HREF="search/svc_acct.cgi?uid">by uid</A>)
+ <LI>mail forwards (<A HREF="search/svc_forward.cgi?svcnum">by service number</A>) (by ?))
+ <LI>domains (<A HREF="search/svc_domain.cgi?svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?domain">by domain</A>)
+ </UL>
+ <LI>unlinked services
+ <UL>
+ <LI>unlinked accounts (<A HREF="search/svc_acct.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?UN_username">by username</A>) (<A HREF="search/svc_acct.cgi?UN_uid">by uid</A>)
+ <LI>unlinked mail forwards (<A HREF="search/svc_forward.cgi?UN_svcnum">by service number</A>) (by ?))
+ <LI>unlinked domains (<A HREF="search/svc_domain.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?UN_domain">by domain</A>)
+ </UL>
+ <LI><A HREF="browse/nas.cgi">NAS ports</A>
+ <LI><A HREF="browse/queue.cgi">Job queue</A>
+ <LI><A HREF="browse/cust_pay_batch.cgi">Pending credit card batch</A>
+ </ul>
+ <li>Miscellaneous
+ <ul>
+ <li><A HREF="search/cust_main-quickpay.html">Quick payment entry</A>
+ </ul>
+ </ul>
+ <hr noshade>
+ <ul>
+ <li><A NAME="config" HREF="config/config-view.cgi">Configuration</a><!-- - <font size="+2" color="#ff0000">start here</font> -->
+ <li><A NAME="admin">Administration</a>
+ <ul>
+ <LI><A HREF="browse/part_svc.cgi">View/Edit service definitions</A>
+ - Services are items you offer to your customers.
+ <LI><A HREF="browse/part_pkg.cgi">View/Edit package definitions</A>
+ - One or more services are grouped together into a package and
+ given pricing information. Customers purchase packages, not
+ services.
+ <LI><A HREF="browse/agent_type.cgi">View/Edit agent types</A>
+ - 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 type).
+ <LI><A HREF="browse/part_referral.cgi">View/Edit referrals</A>
+ - Where a customer heard about your service. Tracked for
+ informational purposes.
+ <LI><A HREF="browse/cust_main_county.cgi">View/Edit locales and tax rates</A>
+ - 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 Access Numbers</A>
+ - Points of Presence
+ <LI><A HREF="browse/part_bill_event.cgi">View/Edit invoice events</A> - Actions for overdue invoices
+ </ul>
+ </ul>
+ </BODY>
+</HTML>
--- /dev/null
+<%
+ my $conf = new FS::Conf;
+ $FS::Conf::DEBUG = 1;
+ my @config_items = $conf->config_items;
+
+ foreach my $i ( @config_items ) {
+ my @touch = ();
+ my @delete = ();
+ my $n = 0;
+ foreach my $type ( ref($i->type) ? @{$i->type} : $i->type ) {
+ if ( $type eq '' ) {
+ } elsif ( $type eq 'textarea' ) {
+ if ( $cgi->param($i->key. $n) ne '' ) {
+ my $value = $cgi->param($i->key. $n);
+ $value =~ s/\r\n/\n/g; #browsers?
+ $conf->set($i->key, $value);
+ } else {
+ $conf->delete($i->key);
+ }
+ } elsif ( $type eq 'checkbox' ) {
+# if ( defined($cgi->param($i->key. $n)) && $cgi->param($i->key. $n) ) {
+ if ( defined $cgi->param($i->key. $n) ) {
+ #$conf->touch($i->key);
+ push @touch, $i->key;
+ } else {
+ #$conf->delete($i->key);
+ push @delete, $i->key;
+ }
+ } elsif ( $type eq 'text' || $type eq 'select' ) {
+ if ( $cgi->param($i->key. $n) ne '' ) {
+ $conf->set($i->key, $cgi->param($i->key. $n));
+ } else {
+ $conf->delete($i->key);
+ }
+ } elsif ( $type eq 'editlist' || $type eq 'selectmultiple' ) {
+ if ( scalar(@{[ $cgi->param($i->key. $n) ]}) ) {
+ $conf->set($i->key, join("\n", @{[ $cgi->param($i->key. $n) ]} ));
+ } else {
+ $conf->delete($i->key);
+ }
+ } else {
+ }
+ $n++;
+ }
+ # warn @touch;
+ $conf->touch($_) foreach @touch;
+ $conf->delete($_) foreach @delete;
+ }
+
+%>
+<%= $cgi->redirect("config-view.cgi") %>
--- /dev/null
+<!-- mason kludge -->
+<%= header('View Configuration', menubar( 'Main Menu' => $p,
+ 'Edit Configuration' => 'config.cgi' ) ) %>
+
+<% my $conf = new FS::Conf; my @config_items = $conf->config_items; %>
+
+<% foreach my $section ( qw(required billing username password UI session
+ shell mail radius apache BIND
+ ),
+ '', 'deprecated') { %>
+ <A NAME="<%= $section || 'unclassified' %>"></A>
+ <FONT SIZE="-2">
+ <% foreach my $nav_section ( qw(required billing username password UI session
+ shell mail radius apache BIND
+ ),
+ '', 'deprecated') { %>
+ <% if ( $section eq $nav_section ) { %>
+ [<A NAME="not<%= $nav_section || 'unclassified' %>" style="background-color: #cccccc"><%= ucfirst($nav_section || 'unclassified') %></A>]
+ <% } else { %>
+ [<A HREF="#<%= $nav_section || 'unclassified' %>"><%= ucfirst($nav_section || 'unclassified') %></A>]
+ <% } %>
+ <% } %>
+ </FONT><BR>
+ <%= table("#cccccc", 2) %>
+ <tr>
+ <th colspan="2" bgcolor="#dcdcdc">
+ <%= ucfirst($section || 'unclassified') %> configuration options
+ </th>
+ </tr>
+ <% foreach my $i (grep $_->section eq $section, @config_items) { %>
+ <tr>
+ <td><a name="<%= $i->key %>">
+ <b><%= $i->key %></b> - <%= $i->description %>
+ </a></td>
+ <td><table border=0>
+ <% foreach my $type ( ref($i->type) ? @{$i->type} : $i->type ) {
+ my $n = 0; %>
+ <% if ( $type eq '' ) { %>
+ <tr><td><font color="#ff0000">no type</font></td></tr>
+ <% } elsif ( $type eq 'textarea'
+ || $type eq 'editlist'
+ || $type eq 'selectmultiple' ) { %>
+ <tr><td bgcolor="#ffffff">
+<pre>
+<%= encode_entities(join("\n", $conf->config($i->key) ) ) %>
+</pre>
+ </td></tr>
+ <% } elsif ( $type eq 'checkbox' ) { %>
+ <tr><td bgcolor="#<%= $conf->exists($i->key) ? '00ff00">YES' : 'ff0000">NO' %></td></tr>
+ <% } elsif ( $type eq 'text' || $type eq 'select' ) { %>
+ <tr><td bgcolor="#ffffff"><%= $conf->exists($i->key) ? $conf->config($i->key) : '' %></td></tr>
+ <% } else { %>
+ <tr><td>
+ <font color="#ff0000">unknown type <%= $type %></font>
+ </td></tr>
+ <% } %>
+ <% $n++; } %>
+ </table></td>
+ </tr>
+ <% } %>
+ </table><br><br>
+<% } %>
+
+</body></html>
--- /dev/null
+<!-- mason kludge -->
+<%= header('Edit Configuration', menubar( 'Main Menu' => $p ) ) %>
+<SCRIPT>
+var gSafeOnload = new Array();
+var gSafeOnsubmit = new Array();
+window.onload = SafeOnload;
+function SafeAddOnLoad(f) {
+ gSafeOnload[gSafeOnload.length] = f;
+}
+function SafeOnload() {
+ for (var i=0;i<gSafeOnload.length;i++)
+ gSafeOnload[i]();
+}
+function SafeAddOnSubmit(f) {
+ gSafeOnsubmit[gSafeOnsubmit.length] = f;
+}
+function SafeOnsubmit() {
+ for (var i=0;i<gSafeOnsubmit.length;i++)
+ gSafeOnsubmit[i]();
+}
+</SCRIPT>
+
+<% my $conf = new FS::Conf; my @config_items = $conf->config_items; %>
+
+<form name="OneTrueForm" action="config-process.cgi" METHOD="POST" onSubmit="SafeOnsubmit()">
+
+<% foreach my $section ( qw(required billing username password UI session
+ shell mail radius apache BIND
+ ),
+ '', 'deprecated') { %>
+ <A NAME="<%= $section || 'unclassified' %>"></A>
+ <FONT SIZE="-2">
+ <% foreach my $nav_section ( qw(required billing username password UI session
+ shell mail radius apache BIND
+ ),
+ '', 'deprecated') { %>
+ <% if ( $section eq $nav_section ) { %>
+ [<A NAME="not<%= $nav_section || 'unclassified' %>" style="background-color: #cccccc"><%= ucfirst($nav_section || 'unclassified') %></A>]
+ <% } else { %>
+ [<A HREF="#<%= $nav_section || 'unclassified' %>"><%= ucfirst($nav_section || 'unclassified') %></A>]
+ <% } %>
+ <% } %>
+ </FONT><BR>
+ <%= table("#cccccc", 2) %>
+ <tr>
+ <th colspan="2" bgcolor="#dcdcdc">
+ <%= ucfirst($section || 'unclassified') %> configuration options
+ </th>
+ </tr>
+ <% foreach my $i (grep $_->section eq $section, @config_items) { %>
+ <tr>
+ <td>
+ <% my $n = 0;
+ foreach my $type ( ref($i->type) ? @{$i->type} : $i->type ) {
+ #warn $i->key unless defined($type);
+ %>
+ <% if ( $type eq '' ) { %>
+ <font color="#ff0000">no type</font>
+ <% } elsif ( $type eq 'textarea' ) { %>
+ <textarea name="<%= $i->key. $n %>" rows=5><%= "\n". join("\n", $conf->config($i->key) ) %></textarea>
+ <% } elsif ( $type eq 'checkbox' ) { %>
+ <input name="<%= $i->key. $n %>" type="checkbox" value="1"<%= $conf->exists($i->key) ? ' CHECKED' : '' %>>
+ <% } elsif ( $type eq 'text' ) { %>
+ <input name="<%= $i->key. $n %>" type="<%= $type %>" value="<%= $conf->exists($i->key) ? $conf->config($i->key) : '' %>">
+ <% } elsif ( $type eq 'select' || $type eq 'selectmultiple' ) { %>
+ <select name="<%= $i->key. $n %>" <%= $type eq 'selectmultiple' ? 'MULTIPLE' : '' %>>
+ <% my %saw;
+ foreach my $value ( "", @{$i->select_enum} ) {
+ local($^W)=0; next if $saw{$value}++; %>
+ <option value="<%= $value %>"<%= $value eq $conf->config($i->key) || ( $type eq 'selectmultiple' && grep { $_ eq $value } $conf->config($i->key) ) ? ' SELECTED' : '' %>><%= $value %>
+ <% } %>
+ <% if ( $conf->exists($i->key) && $conf->config($i->key) && ! grep { $conf->config($i->key) eq $_ } @{$i->select_enum}) { %>
+ <option value=<%= $conf->config($i->key) %> SELECTED><%= conf->config($i->key) %>
+ <% } %>
+ </select>
+ <% } elsif ( $type eq 'editlist' ) { %>
+ <script>
+ function doremove<%= $i->key. $n %>() {
+ fromObject = document.OneTrueForm.<%= $i->key. $n %>;
+ for (var i=fromObject.options.length-1;i>-1;i--) {
+ if (fromObject.options[i].selected)
+ deleteOption<%= $i->key. $n %>(fromObject,i);
+ }
+ }
+ function deleteOption<%= $i->key. $n %>(object,index) {
+ object.options[index] = null;
+ }
+ function selectall<%= $i->key. $n %>() {
+ fromObject = document.OneTrueForm.<%= $i->key. $n %>;
+ for (var i=fromObject.options.length-1;i>-1;i--) {
+ fromObject.options[i].selected = true;
+ }
+ }
+ function doadd<%= $i->key. $n %>(object) {
+ var myvalue = "";
+ <% if ( defined($i->editlist_parts) ) { %>
+
+ <% foreach my $pnum ( 0 .. scalar(@{$i->editlist_parts})-1 ) { %>
+
+ if ( myvalue != "" ) { myvalue = myvalue + " "; }
+ <% if ( $i->editlist_parts->[$pnum]{type} eq 'select' ) { %>
+ myvalue = myvalue + object.add<%= $i->key. $n . "_$pnum" %>.options[object.add<%= $i->key. $n . "_$pnum" %>.selectedIndex].value;
+ <!-- #RESET SELECT?? maybe not... -->
+ <% } elsif ( $i->editlist_parts->[$pnum]{type} eq 'immutable' ) { %>
+ myvalue = myvalue + object.add<%= $i->key. $n . "_$pnum" %>.value;
+ <% } else { %>
+ myvalue = myvalue + object.add<%= $i->key. $n . "_$pnum" %>.value;
+ object.add<%= $i->key. $n. "_$pnum" %>.value = "";
+ <% } %>
+
+
+ <% } %>
+ <% } else { %>
+ myvalue = object.add<%= $i->key. $n. "_1" %>.value;
+ <% } %>
+ var optionName = new Option(myvalue, myvalue);
+ var length = object.<%= $i->key. $n %>.length;
+ object.<%= $i->key. $n %>.options[length] = optionName;
+ }
+ </script>
+ <select multiple size=5 name="<%= $i->key. $n %>">
+ <option selected>----------------------------------------------------------------</option>
+ <% foreach my $line ( $conf->config($i->key) ) { %>
+ <option value="<%= $line %>"><%= $line %></option>
+ <% } %>
+ </select><br>
+ <input type="button" value="remove selected" onClick="doremove<%= $i->key. $n %>()">
+ <script>SafeAddOnLoad(doremove<%= $i->key. $n %>);
+ SafeAddOnSubmit(selectall<%= $i->key. $n %>);</script>
+ <br>
+ <%= itable() %><tr>
+ <% if ( defined $i->editlist_parts ) { %>
+ <% my $pnum=0; foreach my $part ( @{$i->editlist_parts} ) { %>
+ <td>
+ <% if ( $part->{type} eq 'text' ) { %>
+ <input type="text" name="add<%= $i->key. $n."_$pnum" %>">
+ <% } elsif ( $part->{type} eq 'immutable' ) { %>
+ <%= $part->{value} %><input type="hidden" name="add<%= $i->key. $n. "_$pnum" %>" value="<%= $part->{value} %>">
+ <% } elsif ( $part->{type} eq 'select' ) { %>
+ <select name="add<%= $i->key. $n. "_$pnum" %>">
+ <% foreach my $key ( keys %{$part->{select_enum}} ) { %>
+ <option value="<%= $key %>"><%= $part->{select_enum}{$key} %></option>
+ <% } %>
+ </select>
+ <% } else { %>
+ <font color="#ff0000">unknown type <%= $part->type %></font>
+ <% } %>
+ </td>
+ <% $pnum++; } %>
+ <% } else { %>
+ <td><input type="text" name="add<%= $i->key. $n %>_0"></td>
+ <% } %>
+ <td><input type="button" value="add" onClick="doadd<%= $i->key. $n %>(this.form)"></td>
+ </tr></table>
+ <% } else { %>
+ <font color="#ff0000">unknown type <%= $type %></font>
+ <% } %>
+ <% $n++; } %>
+ </td>
+ <td><a name="<%= $i->key %>">
+ <b><%= $i->key %></b> - <%= $i->description %>
+ </a></td>
+ </tr>
+ <% } %>
+ </table><br>
+
+ You may need to restart Apache and/or freeside-queued for configuration
+ changes to take effect.<br>
+
+ <input type="submit" value="Apply changes"><br><br>
+
+<% } %>
+
+</form>
+
+</body></html>
--- /dev/null
+<head>
+ <title>Administration</title>
+</head>
+<body>
+ <h1>Administration</h1>
+</body>
+<ul>
+ <li>Open up the root of the Freeside document tree in your web
+ browser. For example, if you created the Freeside document tree in
+ /home/httpd/html/freeside, and your web browser's DocumentRoot is
+ /home/httpd/html, open https://your_host/freeside/. Replace
+ "your_host" with the name or network address of your web server.
+ <li>Select <u>Configuration</u> from the main menu and update your configuration values.
+ <li>Next you must create a service definition. An example of a service
+ definition would be a dial-up account or a domain. First, it is
+ necessary to create a domain definition. Click on <u>View/Edit service
+ definitions</u> and <u>Add a new service definition</u> with <i>Table</i>
+ <b>svc_domain</b> (and no modifiers).
+
+ <li>Now that you have created your first service, you must create a package
+ including this service which you can sell to customers. Zero, one, or many
+ services are bundled into a package. Click on <u>View/Edit package
+ definitions</u> and <u>Add a new package definition</u> which includes
+ quantity <b>1</b> of the svc_domain service you created above.
+
+ <li>After you create your first package, then you must define who is
+ able to sell that package by creating an agent type. An example of
+ an agent type would be an internal sales representitive which sells
+ regular and promotional packages, as opposed to an external sales
+ representitive which would only sell regular packages of services. Click on
+ <u>View/Edit agent types</u> and <u>Add a new agent type</u>. Allow this
+ agent type to sell the package you created above.
+
+ <li>After creating a new agent type, you must create an agent. Click on
+ <u>View/Edit agents</u> and <u>Add a new agent</u>.
+
+ <li>Set up at least one Advertising source. Advertising sources will help
+ you keep track of how effective your advertising is, tracking where customers
+ heard of your service offerings. You must create at least one advertising
+ source. If you do not wish to use the referral functionality, simply create
+ a single advertising source only. Click on <u>View/Edit advertising
+ sources</u> and <u>Add a new advertising source</u>.
+
+ <li>Click on <u>New Customer</u> and create a new customer for your system
+ accounts with billing type <b>Complimentary</b>.
+
+ <li>From the Customer View screen of the newly created customer, order the
+ package you defined above.
+
+ <li>From the Package View screen of the newly created package, choose
+ <u>(Provision)</u> to add the customer's service for this new package.
+
+ <li>Add your own domain.
+
+ <li>Go back to <u>View/Edit service definitions</u> on the main menu, and
+ <u>Add a new service definition</u> with <i>Table</i> <b>svc_acct</b>.
+ Select your domain in the <b>domsvc</b> Modifier. Set <b>Fixed</b> to define
+ a service locked-in to this domain, or <b>Default</b> to define a service
+ which may select from among this domain and the customer's domains.
+
+ <li><table><tr>
+ <td> Create at least POP (Point of Presence) by selecting
+ <u>View/Edit POPs</u> from the main menu.</td>
+ <th align="left"> OR </th>
+ <td>If you are not doing dialup, set slipip to fixed and blank for all your
+ Service Definitions which have Table <b>svc_acct</b>.</td>
+ </tr></table>
+
+ <li>If you are using Freeside to keep track of sales taxes, define tax
+ information for your locales by clicking on the <u>View/Edit locales and tax
+ rates</b> on the main menu.
+
+ <li>If you would like Freeside to notify your customers when their credit
+ cards and other billing arrangements are about to expire, arrange for
+ <b>freeside-expiration-alerter</b> to be run daily by cron or similar
+ facility. The message it sends can be configured from the
+ <u>Configuration</u> choice of the main menu as <u>alerter_template</u>.
+
+</ul>
+</body>
+</html>
--- /dev/null
+<head>
+ <title>Billing</title>
+</head>
+<body>
+ <h1>Billing</h1>
+ <ul>
+ <li>You can bill individual customers by clicking on the <i>Bill now</i> link on the main customer view.
+ <li>The <a href="man/bin/freeside-daily.html"><b>freeside-daily</b></a> script should be run daily to bill customers and run invoice collection events.
+ <li>Real-time credit card processing: Install the <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> module for your processor. Configure the <a href="../config/config-view.cgi#business-onlinepayment">business-onlinepayment</a> configuration option. Disable the default <b>Batch card</b> <a href="../browse/part_bill_event.cgi">invoice event</a> and add one for Business::OnlinePayment.
+ <li>Optional: Credit card expiration alerts: Customize <a href="../config/config.cgi#alerter_template">alerter_template</a> configuration option and run <a href="man/bin/freeside-expiration-alerter.html">freeside-expiration-alerter</a> daily.
+ <li>Credit card decline alerts: Customize the <a href="../config/config.cgi#declinetemplate">declinetemplate</a> configuration option and set the <a href="../config/config.cgi#emaildecline">emaildecline</a> configuration option.
+ <li>Optional: Invoice template customization
+ <ul>
+ <li>See the <a href="http://search.cpan.org/doc/MJD/Text-Template-1.42/Template.pm">Text::Template</a> documentation for details on the substitution language.
+ <li>You <b>must</b> call the invoice_lines() function at least once - pass it a number of lines, and it returns a list of array references, each of two elements: a service description column, and a price column. Alternatively, call invoice_lines() with no arguments, and pagination will be disabled - all invoice line items will print on one page, with no padding (recommended for email invoices).
+ <li>In addition, the following variables are available:
+ <ul>
+ <li>$invnum - invoice number
+ <li>$date - as a UNIX timestamp (see <a href="http://search.cpan.org/doc/GBARR/TimeDate-1.09/lib/Date/Format.pm">Date::Format</a> for conversion functions).
+ <li>$page - current page
+ <li>$total_pages - total pages
+ <li>@address - A six-element array containing the customer name, company, and address.
+<!-- <li>$overdue - true if this invoice is overdue -->
+ </ul>
+ </ul>
+ <li>Batch credit card processing
+ <ul>
+ <li>After <a href="man/bin/freeside-daily.html"><b>freeside-daily</b></a> is run, a credit card batch will be in the <a href="schema.html#cust_pay_batch">cust_pay_batch</a> table. Export this table to your credit card batching.
+ <li>When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the <a href="schema.html#cust_pay">cust_pay</a> table. Example code to add payments is:
+ <pre>use FS::cust_pay;
+
+# loop over all records in batch
+
+my $payment=create FS::cust_pay (
+ 'invnum' => $invnum,
+ 'paid' => $paid,
+ '_date' => $_date,
+ 'payby' => $payby,
+ 'payinfo' => $payinfo,
+ 'paybatch' => $paybatch,
+);
+
+my $error=$payment->insert;
+if ( $error ) {
+ #process error
+}
+
+# end loop
+</pre>
+All fields except paybatch are contained in the cust_pay_batch table. You can use paybatch field to track particular batches and/or particular transactions within a batch.
+ </ul>
+<!-- <li>The <a href="man/bin/freeside-print-batch.html"><b>freeside-print-batch</b></a> script can print or email pending credit card batches for manual entry. -->
+ </ul>
+</body>
--- /dev/null
+<head>
+ <title>Configuration files</title>
+</head>
+<body>
+ <h1>Configuration files</h1>
+<font size="+1" color="#ff0000">Configuration is now done by the top-level Makefile and web interface. The instructions below are no longer necessary.</font>
+<ul>
+ <li>Create the <b>/usr/local/etc/freeside</b> directory to hold your configuration.
+ <li>Setting up <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">Apache user authetication</a> is mandatory.
+ <li>Create the <b>/usr/local/etc/freeside/mapsecrets</b> file, which maps Apache users to a secrets file which contains a DBI data source, username and password. Every
+line in <b>/usr/local/etc/freeside/mapsecrets</b> should contain a username and
+filename, separated by whitespace. Note that these are not local usernames -
+they are passed from Apache. <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">
+Apache user authetication</a> is mandatory. For example, if you had the Apache users admin,
+john, and sam,
+you mapsecrets file might look like:
+<pre>
+admin secretfile
+john secretfile
+sam secretfile
+</pre>
+ <li>Next, the filename(s) referenced in <b>/usr/local/etc/freeside/mapsecrets</b> file should be created in the <b>/usr/local/etc/freeside/</b> directory. Each file contains three lines: <a href="http://search.cpan.org/doc/TIMB/DBI-1.20/DBI.pm">DBI data source</a> (for example,
+ <tt>DBI:mysql:freeside</tt> or <tt>DBI:Pg:host=localhost;dbname=freeside</tt>), database username, and database password.
+ These files should not be world readable. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.20/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD">manpage for your DBD</a> for the exact syntax of a DBI data source. In a normal installation such as the example above, a single file <b>/usr/local/etc/freeside/secretfile</b> would be created - for example:
+<pre>
+DBI:Pg:host=localhost;dbname=freeside
+dbusername
+dbpassword
+</pre>
+<li>Create the <b>/usr/local/etc/freeside/conf.<i>datasource</i></b> directory, for example, <b>/usr/local/etc/freeside/conf.DBI:Pg:host=localhost;dbname=freeside</b> (remember to backslash-escape the ; character when creating directories in the shell:
+<pre>mkdir /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=freeside
+</pre>
+<li>The rest of the configuration can be done with the web interface. Select <u>Configuration</u> from the main menu and update your configuration values.
+</ul>
+</body>
+</html>
--- /dev/null
+<head>
+ <title>File exporting</title>
+</head>
+<body>
+ <h1>File exporting</h1>
+ <font size="+2">NOTE: This file is OUT OF DATE with the landing of the new export code and is only here for reference. DO NOT follow these instructions. Instead use the new exports in the web interface.</font>
+ <ul>
+ <li>bin/svc_acct.export will create UNIX <b>passwd</b>, <b>shadow</b> and <b>master.passwd</b> files, ERPCD <b>acp_passwd</b> and <b>acp_dialup</b> files and a RADIUS <b>users</b> file in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Some RADIUS servers (such as <a href="http://www.open.com.au/radiator/">Radiator</a>, <a href="ftp://ftp.cheapnet.net/pub/icradius/">ICRADIUS</a> and <a href="http://www.freeradius.org/">FreeRADIUS</a>) will authenticate directly out of an SQL database. In these cases,
+it is reccommended that you replicate (<a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">Replication in MySQL</a>) the data to an external RADIUS machine or point icradius_secrets to the external machine rather than running the RADIUS server on your Freeside machine. Using the appropriate <a href="../config/config-view.cgi">configuration settings</a>, you can export these files to your remote machines unattended:
+ <ul>
+ <li>shellmachines - <b>passwd</b> and <b>shadow</b> are copied to the remote machine as <b>/etc/passwd.new</b> and <b>/etc/shadow.new</b> and then moved to <b>/etc/passwd</b> and <b>/etc/shadow</b> if no errors occur.
+ <li>bsdshellmachines - <b>passwd</b> and <b>master.passwd</b> are copied to the remote machine as <b>/etc/passwd.new</b> and <b>/etc/master.passwd.new</b> and moved to <b>/etc/passwd</b> and <b>/etc/master.passwd</b> if no errors occur.
+ <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.
+ <li>icradiusmachines - Turn this option on to enable radcheck table population - by default in the Freeside database, or in the database specified by the <a href="http://rootwood.haze.st/aspside/config/config-view.cgi#icradius_secrets">icradius_secrets</a> config option (the radcheck table needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option. <blockquote><b>ADDITIONAL DEPRECATED FUNCTIONALITY</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines or <a href="http://www.freeradius.org/">FreeRADIUS</a> (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: <CODE>"radius.isp.tld radius_db radius_user passw0rd"</CODE></blockquote>
+ </ul>
+ <li>svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below.
+ <ul>
+ <li>Account creation - If the <b>username</b>, <b>uid</b> and <b>dir</b> fields are defined for a new user, the command(s) specified in the <a href="../config/config-view.cgi#shellmachine-useradd">shellmachine-useradd</a> configuration file are executed on shellmachine via ssh. If this file does not exist, <code>useradd -d $dir -m -s $shell -u $uid $username</code> is the default. If the file exists but is empty, <code>cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</code> is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$username</code>, <code>$uid</code>, <code>$gid</code>, <code>$dir</code>, and <code>$shell</code>.
+ <li>Account deletion - The command(s) specified in the <a href="../config/config-view.cgi#shellmachine-userdel">shellmachine-userdel</a> configuration file are executed on shellmachine via ssh. If this file does not exist, <code>userdel $username</code> is the default. If the file exists but is empty, <code>rm -rf $dir</code> is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$username</code> and <code>$dir</code>.
+ <li>Account modification - If a user's home directory changes, the command(s) specified in the <a href="../config/config-view.cgi#shellmachine-usermod">shellmachine-usermod</a> configuration file are execute on shellmachine via ssh. If this file does not exist or is empty, <code>[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir )</code> is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$old_dir</code>, <code>$new_dir</code>, <code>$uid</code> and <code>$gid</code>.
+ </ul>
+ <li>svc_acct.pm - <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a> integration, enabled by the <a href="../config/config-view.cgi#cyrus">cyrus configuration file</a>
+ <ul>
+ <li>Account creation - (Cyrus::IMAP::Admin should be installed locally)
+ <li>Account deletion - (Cyrus::IMAP::Admin should be installed locally)
+ <li>Account modification - (not yet implemented)
+ </ul>
+ <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/config-view.cgi">configuration files</a>, you can export these files to your remote machines unattemded:
+ <ul>
+ <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>. If no errors occur, they are moved to <b>/etc/sendmail.cw</b> and <b>/etc/virtusertable</b> and the command specified in the <a href="../config/config-view.cgi#sendmailrestart">sendmailrestart</a> configuration file is executed. (The path can be changed from the default <b>/etc</b> with the <a href="../config/config-view.cgi#sendmailconfigpath">sendmailconfigpath</a> configuration file.)
+ </ul>
+ <li>svc_domain.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user <b>.qmail-</b> files can be updated for catchall mailboxes.
+ <ul>
+ <li>The command <pre>[ -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;
+}</pre> is run.
+ </ul>
+ <li>svc_forward.pm - Not yet documented; see manpage.
+ <li>svc_www.pm - Not yet documented; see manpage.
+ </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>
+ <ul>
+ <li>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.eu.org/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, use a blank passphrase.
+ <li>Append the newly-created <code>identity.pub</code> file to <code>~root/.ssh/authorized_keys</code> on the remote machine(s).
+ <li>Some new SSH v2 implementation accept v2 style keys only. Use the <code>-t</code> option to <a href="http://www.tac.eu.org/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>, and append the created <code>id_dsa.pub</code> or <code>id_rsa.pub</code> to <code>~root/.ssh/authorized_keys2</code> on the remote machine(s).
+ <li>You may need to set <code>PermitRootLogin without-password</code> (meaning with keys only) in your <code>sshd_config</code> file on the remote machine(s).
+ </ul>
+
+</body>
+
--- /dev/null
+<head>
+ <title>Documentation</title>
+</head>
+<body bgcolor="#ffffff">
+ <h1>Documentation</h1>
+<img src="overview.png">
+<ul>
+ <li><a href="install.html">New Installation</a>
+ <li><a href="upgrade4.html">Upgrading from 1.2.x to 1.2.2</a>
+ <li><a href="upgrade5.html">Upgrading from 1.2.2 to 1.2.3</a>
+ <li><a href="upgrade6.html">Upgrading from 1.2.3 to 1.3.0</a>
+ <li><a href="upgrade7.html">Upgrading from 1.3.0 to 1.3.1</a>
+ <li><a href="upgrade8.html">Upgrading from 1.3.1 to 1.4.0</a>
+<!--
+ <li><a href="config.html">Configuration files</a>
+!-->
+ <li><a href="admin.html">Administration</a>
+<!--
+ <li><a href="../index.html#admin">Administration</a>
+!-->
+ <li><a href="legacy.html">Importing legacy data</a>
+ <li><a href="export.html">File exporting and remote setup</a>
+ <li><a href="passwd.html">fs_passwd</a>
+ <li><a href="signup.html">Signup server</a>
+ <li><a href="session.html">Session monitor</a>
+ <li><a href="billing.html">Billing</a>
+ <li><a href="schema.html">Schema reference</a>
+ <li><a href="man/FS.html">Perl API</a>
+</ul>
+</body>
--- /dev/null
+<head>
+ <title>Installation</title>
+</head>
+<body>
+<h1>Installation</h1>
+Before installing, you need:
+<ul>
+ <li><a href="http://www.perl.com/">Perl</a> Don't enable experimental features like threads or the PerlIO abstraction layer.
+ <li><a href="http://www.apache.org">Apache</a> (<a href="http://www.modssl.org/">mod_ssl</a> or <a href="http://www.apache-ssl.org">Apache-SSL</a> highly recommended)
+ <li><a href="http://perl.apache.org/">mod_perl</a> (if compiling your own mod_perl, make sure you set the <a href="http://perl.apache.org/guide/install.html#EVERYTHING">EVERYTHING</a>=1 compile-time option)
+ <li><a href="http://www.openssh.com/">SSH</a> (<a href="http://www.openssh.com//">OpenSSH</a> is recommended. SSH Communications Security <a href="http://www.ssh.com/products/ssh/download.cfm">commercial SSH version 3</a> has been reported incompatible with Freeside.)
+ <li><a href="http://rsync.samba.org/">rsync</a>
+ <li>A <b>transactional</b> database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>.
+ <ul>
+ <li><a href="http://www.postgresql.org/">PostgreSQL</a> (v7 or higher) is recommended.
+ <li><b>MySQL is NOT supported at this time.</b> If you are a developer who wishes to contribute MySQL support, see the <a href="mysql.html">MySQL notes</a>.
+ <!-- <li>MySQL has been reported to work. -->
+ <!-- <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>. If you really want to use MySQL, you need to use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>, and set it as the default table type using the <code>--default-table-type=BDB</code> <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Command-line_options">mysqld command-line option</a> or by setting <code>default-table-type=BDB</code> in the <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Option_files">my.cnf option file</a>.-->
+ </ul>
+ <li>Perl modules (<a href="http://theoryx5.uwinnipeg.ca/CPAN/perl/CPAN.html">CPAN</a> will query, download and build perl modules automatically)
+ <ul>
+ <li><a href="http://search.cpan.org/search?dist=Array-PrintCols">Array-PrintCols</a>
+ <li><a href="http://search.cpan.org/search?dist=Term-Query">Term-Query</a> (make test broken; install manually)
+ <li><a href="http://search.cpan.org/search?dist=MIME-Base64">MIME-Base64</a>
+ <li><a href="http://search.cpan.org/search?dist=Digest-MD5">Digest-MD5</a>
+ <li><a href="http://search.cpan.org/search?dist=MD5">MD5</a>
+ <li><a href="http://search.cpan.org/search?dist=URI">URI</a>
+ <li><a href="http://search.cpan.org/search?dist=HTML-Tagset">HTML-Tagset</a>
+ <li><a href="http://search.cpan.org/search?dist=HTML-Parser">HTML-Parser</a>
+ <li><a href="http://search.cpan.org/search?dist=libnet">libnet</a>
+ <li><a href="http://search.cpan.org/search?dist=Locale-Codes">Locale-Codes</a>
+ <li><a href="http://search.cpan.org/search?dist=Net-Whois">Net-Whois</a>
+ <li><a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a>
+ <li><a href="http://search.cpan.org/search?dist=Business-CreditCard">Business-CreditCard</a>
+ <li><a href="http://search.cpan.org/search?dist=Data-ShowTable">Data-ShowTable</a>
+ <li><a href="http://search.cpan.org/search?dist=MailTools">MailTools</a>
+ <li><a href="http://search.cpan.org/search?dist=TimeDate">TimeDate</a>
+ <li><a href="http://search.cpan.org/search?dist=DateManip">DateManip</a>
+ <li><a href="http://search.cpan.org/search?dist=File-CounterFile">File-CounterFile</a>
+ <li><a href="http://search.cpan.org/search?dist=FreezeThaw">FreezeThaw</a>
+ <li><a href="http://search.cpan.org/search?dist=String-Approx">String-Approx</a>
+ <li><a href="http://search.cpan.org/search?dist=Text-Template">Text-Template</a>
+ <li><a href="http://search.cpan.org/search?dist=DBI">DBI</a>
+ <li><a href="http://search.cpan.org/search?mode=module&query=DBD">DBD for your database engine</a> (<a href="http://search.cpan.org/search?dist=DBD-Pg">DBD::Pg</a> for PostgreSQL, <a href="http://search.cpan.org/search?dist=DBD-mysql">DBD::mysql</a> for MySQL)
+ <li><a href="http://search.cpan.org/search?dist=DBIx-DataSource">DBIx-DataSource</a>
+ <li><a href="http://search.cpan.org/search?dist=DBIx-DBSchema">DBIx-DBSchema</a>
+ <li><a href="http://search.cpan.org/search?dist=Net-SSH">Net-SSH</a>
+ <li><a href="http://search.cpan.org/search?dist=String-ShellQuote">String-ShellQuote</a>
+ <li><a href="http://search.cpan.org/search?dist=Net-SCP">Net-SCP</a>
+ <li><a href="http://www.apache-asp.org/">Apache::ASP</a> or <a href="http://www.masonhq.com/">HTML::Mason</a>
+ <li><a href="http://search.cpan.org/search?dist=Tie-IxHash">Tie-IxHash</a>
+ <li><a href="http://search.cpan.org/search?dist=Time-Duration">Time-Duration</a>
+ <li><a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a>
+ <li><a href="http://search.cpan.org/search?dist=Storable">Storable</a>
+ <li><a href="http://search.cpan.org/search?dist=ApacheDBI">Apache::DBI</a> <i>(optional but recommended for better webinterface performance)</i>
+ </ul>
+</ul>
+Install the Freeside distribution:
+<ul>
+ <li>Add the user `freeside' to your system.
+ <li>Allow the freeside user full access to the freeside database.
+ <ul>
+ <li> with <a href="http://www.postgresql.org/users-lounge/docs/7.1/postgres/user-manag.html#DATABASE-USERS">PostgreSQL</a>:
+ <pre>
+$ su postgres
+$ createuser -P freeside
+Enter password for user "freeside":
+Enter it again:
+Shall the new user be allowed to create databases? (y/n) y
+Shall the new user be allowed to create more new users? (y/n) n
+CREATE USER</pre>
+ <li> with <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#User_Account_Management">MySQL</a>:
+ <pre>
+$ mysqladmin -u root password '<i>set_a_root_database_password</i>'
+$ mysql -u root -p
+mysql> GRANT SELECT,INSERT,UPDATE,DELETE,INDEX,ALTER,CREATE,DROP on freeside.* TO freeside@localhost IDENTIFIED BY '<i>set_a_freeside_database_password</i>';</pre>
+ </ul>
+<!-- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>-->
+ <li>Edit the top-level Makefile:
+ <ul>
+ <li>Set <tt>DATASOURCE</tt> to your <a href="http://search.cpan.org/doc/TIMB/DBI-1.20/DBI.pm">DBI data source</a>, for example, <tt>DBI:Pg:host=localhost;dbname=freeside</tt> for PostgresSQL or <tt>DBI:mysql:freeside</tt> for MySQL. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.20/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD">manpage for your DBD</a> for the exact syntax of a DBI data source.
+ <li>Set <tt>DB_PASSWORD</tt> to the freeside database user's password.
+ </ul>
+ <li>Add the freeside database to your database engine:
+ <pre>
+$ su
+# make create-database</pre>
+ (or manually, with Postgres:)
+ <pre>
+$ su freeside
+$ createdb freeside</pre>
+ (with MySQL:)
+ <pre>
+$ mysqladmin -u freeside -p create freeside </pre>
+ <li>Build and install the Perl modules:
+ <pre>
+$ make perl-modules
+$ su
+# make install-perl-modules</pre>
+ <li>Create the necessary configuration files:<pre>
+$ su
+# make create-config
+</pre>
+ <li>Run a <b>separate</b> iteration of Apache[-SSL] with mod_perl enabled <b>as the freeside user</b>.
+</ul>
+<table>
+ <tr>
+ <th>Apache::ASP</th><th>Mason</th>
+ </tr>
+ <tr>
+ <td><ul>
+ <li>Run <tt>make aspdocs</tt>
+ <li>Copy <tt>aspdocs/</tt> to your web server's document space.
+ <li>Create a <a href="http://www.apache-asp.org/config.html#Global">Global</a> directory, such as <tt>/usr/local/etc/freeside/asp-global/</tt>:
+<font size="-1"><pre>
+mkdir /usr/local/etc/freeside/asp-global/
+chown freeside /usr/local/etc/freeside/asp-global/
+</pre></font>
+ <li>Copy <tt>htetc/global.asa</tt> to the Global directory:
+<font size="-1"><pre>
+cp htetc/global.asa /usr/local/etc/freeside/asp-global/global.asa
+</pre></font>
+ <li>Configure Apache for the Global directory and to execute .cgi files using Apache::ASP. For example:
+<font size="-1"><pre>
+<Directory /usr/local/apache/htdocs/freeside-asp>
+<Files ~ (\.cgi)>
+AddHandler perl-script .cgi
+PerlHandler Apache::ASP
+</Files>
+<Perl>
+$MLDBM::RemoveTaint = 1;
+</Perl>
+PerlSetVar Global /usr/local/etc/freeside/asp-global/
+PerlSetVar Debug 2
+</Directory>
+</pre></font>
+ </ul></td>
+ <td><ul>
+ <li>Run <tt>make masondocs</tt>
+ <li>Copy <tt>masondocs/</tt> to your web server's document space.
+ <li>Copy <tt>htetc/handler.pl</tt> to your web server's configuration directory.
+ <li>Edit <tt>handler.pl</tt> and set an appropriate <tt>data_dir</tt>, such as <tt>/usr/local/etc/freeside/mason-data</tt>
+ <li>Configure Apache to use the <tt>handler.pl</tt> file and to execute .cgi files using HTML::Mason. For example:
+<font size="-1"><pre>
+<Directory /usr/local/apache/htdocs/freeside-mason>
+<Files ~ (\.cgi)>
+AddHandler perl-script .cgi
+PerlHandler HTML::Mason
+</Files>
+<Perl>
+require "/usr/local/apache/conf/handler.pl";
+</Perl>
+</Directory>
+</pre></font>
+ </ul></td>
+ </tr>
+</table>
+<ul>
+<li>Restrict access to this web interface - see the <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache documentation on user authentication</a>. For example, to configure user authentication with <a href="http://httpd.apache.org/docs/mod/mod_auth.html">mod_auth</a> (flat files):
+<pre>
+<Directory /usr/local/apache/htdocs/freeside-asp>
+PerlSetVar Global /usr/local/etc/freeside/asp-global/
+AuthName Freeside
+AuthType Basic
+AuthUserFile /usr/local/etc/freeside/htpasswd
+require valid-user
+</Directory>
+</pre>
+ <li>Create one or more Freeside users (your internal sales/tech folks, not customer accounts). These users are setup using using Apache authentication, not UNIX user accounts. For example, using <a href="http://httpd.apache.org/docs/mod/mod_auth.html">mod_auth</a> (flat files):
+ <ul>
+ <li>First user:<font size="-1">
+<pre>$ su
+$ <a href="man/bin/freeside-adduser.html">freeside-adduser</a> -c -h /usr/local/etc/freeside/htpasswd <i>username</i></pre></font>
+ <li>Additional users:<font size="-1">
+<pre>$ su
+$ <a href="man/bin/freeside-adduser.html">freeside-adduser</a> -h /usr/local/etc/freeside/htpasswd <i>username</i></pre></font>
+ </ul>
+ <i>(using other auth types, add each user to your <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache authentication</a> and then run: <tt>freeside-adduser <b>username</b></tt></i>
+ <li>As the freeside UNIX user, run <tt>bin/fs-setup <b>username</b></tt> to create the database tables, passing the username of a Freeside user you created above:
+<pre>
+$ su freeside
+$ bin/fs-setup <b>username</b>
+</pre>
+ <li>As the freeside UNIX user, run <tt>bin/populate-msgcat <b>username</b></tt> to populate the message catalog, passing the username of a Freeside user you created above:
+<pre>
+$ su freeside
+$ bin/populate-msgcat <b>username</b>
+</pre>
+ <li><tt>freeside-queued</tt> was installed with the Perl modules. Start it now and ensure that is run upon system startup (Do this manually, or, edit the top-level Makefile, replacing INIT_FILE with the appropriate location on your system, and run <tt>make install-init</tt>.
+ <li>Now proceed to the initial <a href="admin.html">administration</a> of your installation.
+</ul>
+</body>
--- /dev/null
+<head>
+ <title>Importing legacy data</title>
+</head>
+<body>
+ <h1>Importing legacy data</h1>
+<font size="+2">In most cases, legacy data import all cases will require writing custom code to deal with your particular legacy data. The example scripts here will not work "out-of-the-box". Importing your legacy data will most probably involve some hacking on the example scripts noted below. Contributions to the import process are welcome.</font>
+<ul>
+ <li><a name="svc_domain">bin/svc_domain.import</a> - Import domain information from BIND named
+ <li><a name="svc_acct">bin/passwd.import</a> - Just import `passwd' and `shadow' or `master.passwd', no RADIUS import.
+ <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)
+ <li>Some accounts might have entries in users only (Port-Limit 1)
+ <li>Some accounts might have entries in users only (Port-Limit >= 2)
+ <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="../browse/part_svc.cgi">services</a> as follows:
+ <ul>
+ <li>Domain (table svc_acct)
+ <li>Mail alias (table svc_acct_sm)
+ </ul>
+ <li><a name="cust_main">Importing customer data</a>
+ <ul>
+ <li>Manually
+ <ul>
+ <li>Add a <a href="../edit/cust_main.cgi">new customer</a>
+ <li>Add one or more packages for this customer
+ <li>Enter a package by clicking on the package number
+ <li>Pick the `Link to existing' option
+ </ul>
+ <li>Batch - You will need to write a script to import your particular legacy data. You can use eg/TEMPLATE_cust_main.import as a starting point.
+ </ul>
+</ul>
+</body>
+
--- /dev/null
+<head>
+ <title>MySQL notes</title>
+</head>
+<body>
+ <h1>MySQL notes</h1>
+<font size=+2><b>MySQL is NOT supported at this time.</b></font>
+<i>The following information is provided for developers who wish to contribute MySQL support. Note that <b>ALL</b> of the items listed below need to be resolved to support MySQL.
+<ul>
+ <li>See ticket <a href="http://pouncequick.420.am/rt/Ticket/Display.html?id=300">#300</a> in the bug-tracking system.
+ <li><b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">My
+ISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>. You need to use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>, and set it as the default table type using the <code>--default-table-type=BDB</code> <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Command-line_options">mysqld command-line option</a> or by setting <code>default-table-type=BDB</code> in the <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Option_files">my.cnf option file</a>.
+</ul>
+</body>
--- /dev/null
+<head>
+ <title>fs_passwd</title>
+</head>
+<body>
+ <h1>fs_passwd</h1>
+You may use fs_passwd/fs_passwd as a "passwd", "chfn" and "chsh" replacement on your shell machine(s) to cause password, gecos and shell changes to update your freeside machine. You can also use the fs_passwd/fs_passwd.html and fs_passwd/fs_passwd.cgi to run a public password change CGI on a public web server. This can pose a security risk if not configured correctly. <b>Do not use this feature unless you understand what you are doing!</b>
+<br><br>Currently it is assumed that the the crypt(3) function in the C library is the same on the Freeside machine as on the target machine.
+<ul>
+ <li>Create a freeside account on the shell or web machine(s).
+ <li>Setup SSH keys:
+ <ul>
+ <li>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.eu.org/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, use a blank passphrase.
+ <li>Append the newly-created <code>identity.pub</code> file to <code>~freeside
+/.ssh/authorized_keys</code> on the shell or web machine(s).
+ <li>Some new SSH v2 implementation accept v2 style keys only. Use the <code>-t</code> option to <a href="http://www.tac.eu.org/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>, and append the created <code>id_dsa.pub</code> or <code>id_rsa.pub</code> to <code>~freeside/.ssh/authorized_keys2</code> on the remote machine(s).
+ </ul>
+ <li>Copy fs_passwd/fs_passwdd to /usr/local/sbin on the shell or web machine(s). (chown freeside, chmod 500)
+ <li>Create /usr/local/freeside on the shell or web machine(s). (chown freeside, chmod 700)
+ <li>Run an iteration of "fs_passwd/fs_passwd_server <i>user</i> shell.machine" as the freeside user for each shell or web machine (this is a daemon process). <i>user</i> refers to a freeside user added by <a href="man/bin/freeside-adduser.html">freeside-adduser</a>.
+ <li>Copy fs_passwd/fs_passwd to /usr/local/bin on the shell machine(s). (chown freeside, chmod 4755). You may link it to passwd, chfn and chsh as well.
+ <li>Copy fs_passwd/fs_passwd.cgi to the cgi-bin directory on your web machine(s). Use <a href="http://www.apache.org/docs/suexec.html">suEXEC</a> or <a href="http://www.perldoc.com/perl5.6.1/pod/perlsec.html">suidperl</a> to run fs_passwd.cgi as the freeside user.
+</ul>
+</body>
--- /dev/null
+<head>
+ <title>Schema reference</title>
+</head>
+<body>
+ <h1>Schema reference</h1>
+ Schema diagram: <a href="schema.png">as a giant .png</a> or <a href="schema.dia">dia source</a> (<a href="http://www.lysator.liu.se/~alla/dia/">dia homepage</a>).
+ <ul>
+ <li><a name="agent" href="man/FS/agent.html">agent</a> - Agents are resellers of your service. Agents may be limited to a subset of your full offerings (via their agent type).
+ <ul>
+ <li>agentnum - primary key
+ <li>agent - name of this agent
+ <li>typenum - <a href="#agent_type">agent type</a>
+ <li>prog - (unimplemented)
+ <li>freq - (unimplemented)
+ </ul>
+ <li><a name="agent_type" href="man/FS/agent_type.html">agent_type</a> - Agent types define groups of packages that you can then assign to particular agents.
+ <ul>
+ <li>typenum - primary key
+ <li>atype - name of this agent type
+ </ul>
+ <li><a name="cust_bill" href="man/FS/cust_bill.html">cust_bill</a> - Invoices. Declarations that a customer owes you money. The specific charges are itemized in <a href="#cust_bill_pkg">cust_bill_pkg</a>.
+ <ul>
+ <li>invnum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>_date
+ <li>charged - amount of this invoice
+ <li>printed - how many times this invoice has been printed automatically
+ <li>closed - books closed flag, empty or `Y'
+ </ul>
+ <li><a name="cust_bill_event" href="man/FS/cust_bill_event.html">cust_bill_event</a> - Invoice event history
+ <ul>
+ <li>eventnum - primary key
+ <li>invnum - <a href="#cust_bill">invoice</a>
+ <li>eventpart - <a href="#part_bill_event">event definition</a>
+ <li>_date
+ <li>status
+ <li>statustext
+ </ul>
+ <li><a name="part_bill_event" href="man/FS/part_bill_event.html">part_bill_event</a> - Invoice event definitions
+ <ul>
+ <li>eventpart - primary key
+ <li>payby - CARD, BILL, or COMP
+ <li>event - event name
+ <li>eventcode - event action
+ <li>seconds - how long after the invoice date (<a href="#cust_bill">cust_bill</a>._date) events of this type are triggered
+ <li>weight - ordering for events with identical seconds
+ <li>plan - eventcode plan
+ <li>plandata - additional plan data
+ <li>disabled - Disabled flag, empty or `Y'
+ <li>taxclass - Texas tax class flag, empty or "none", "access", or "hosting"
+ </ul>
+ <li><a name="cust_bill_pkg" href="man/FS/cust_bill_pkg.html">cust_bill_pkg</a> - Invoice line items
+ <ul>
+ <li>invnum - (multiple) key
+ <li>pkgnum - <a href="#cust_pkg">package</a> or 0 for the special virtual sales tax package
+ <li>setup - setup fee
+ <li>recur - recurring fee
+ <li>sdate - starting date
+ <li>edate - ending date
+ </ul>
+ <li><a name="cust_credit" href="man/FS/cust_credit.html">cust_credit</a> - Credits. The equivalent of a negative <a href="#cust_bill">cust_bill</a> record.
+ <ul>
+ <li>crednum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>amount - amount credited
+ <li>_date
+ <li>otaker - order taker
+ <li>reason
+ <li>closed - books closed flag, empty or `Y'
+ </ul>
+ <li><a name="cust_credit_bill" href="man/FS/cust_credit_bill.html">cust_credit_bill</a> - Credit invoice application. Links a credit to an invoice.
+ <ul>
+ <li>creditbillnum - primary key
+ <li>crednum - <a href="#cust_credit">credit</a> being applied
+ <li>invnum - <a href="#cust_bill">invoice</a> to which credit is applied
+ <li>amount - amount applied
+ <li>_date
+ </ul>
+ <li><a name="cust_main" href="man/FS/cust_main.html">cust_main</a> - Customers
+ <ul>
+ <li>custnum - primary key
+ <li>agentnum - <a href="#agent">agent</a>
+ <li>refnum - <a href="#part_referral">referral</a>
+ <li>first - name
+ <li>last - name
+ <li>ss - social security number
+ <li>company
+ <li>address1
+ <li>address2
+ <li>city
+ <li>county
+ <li>state
+ <li>zip
+ <li>country
+ <li>daytime - phone
+ <li>night - phone
+ <li>fax - phone
+ <li><i>ship_first</i>
+ <li><i>ship_last</i>
+ <li><i>ship_company</i>
+ <li><i>ship_address1</i>
+ <li><i>ship_address2</i>
+ <li><i>ship_city</i>
+ <li><i>ship_county</i>
+ <li><i>ship_state</i>
+ <li><i>ship_zip</i>
+ <li><i>ship_country</i>
+ <li><i>ship_daytime</i>
+ <li><i>ship_night</i>
+ <li><i>ship_fax</i>
+ <li>payby - CARD, BILL, or COMP
+ <li>payinfo - card number, P.O.#, or comp issuer
+ <li>paydate - expiration date
+ <li>payname - billing name (name on card)
+ <li>tax - tax exempt, Y or null
+ <li>otaker - order taker
+ <li>referral_custnum
+ <li>comments
+ </ul>
+ (columns in <i>italics</i> are optional)
+ <li><a name="cust_main_invoice" href="man/FS/cust_main_invoice.html">cust_main_invoice</a> - Invoice destinations for email invoices. Note that a customer can have many email destinations for their invoice (either literal or via svcnum), but only one postal destination.
+ <ul>
+ <li>destnum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>dest - Invoice destination. Freeside supports three types of invoice delivery: send directly to a service defined in Freeside, send to an arbitrary email address, or print the invoice to a printer and have someone send it out via snail mail. Freeside determines which method to use based on the contents of the dest field. If the contents are numeric, a <a href="#svc_acct">svcnum</a> pointing to a valid service is expected in the field. If the contents are a string, a literal email address is expected to be in the field. If the special keyword `POST' is present, the snail mail method is used (which is the default if no cust_main_invoice records exist). Snail mail invoices get their address information from <A name="#cust_main">cust_main</A> and are printed with the printer defined in the configuration files.
+ </ul>
+ <li><a name="cust_main_county" href="man/FS/cust_main_county.html">cust_main_county</a> - Tax rates
+ <ul>
+ <li>taxnum - primary key
+ <li>state
+ <li>county
+ <li>country
+ <li>tax - % rate
+ <li>taxclass
+ <li>exempt_amount
+ </ul>
+ <li><a name="cust_tax_exempt" href="man/FS/cust_tax_exempt.html">cust_tax_exempt</a> - Tax exemption record
+ <ul>
+ <li>exemptnum - primary key
+ <li>taxnum - <a href="#cust_main_county">tax rate</a>
+ <li>year
+ <li>month
+ <li>amount
+ </ul>
+ <li><a name="cust_pay" href="man/FS/cust_pay.html">cust_pay</a> - Payments. Money being transferred from a customer.
+ <ul>
+ <li>paynum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>paid - amount
+ <li>_date
+ <li>payby - CARD, BILL, or COMP
+ <li>payinfo - card number, P.O.#, or comp issuer
+ <li>paybatch - text field for tracking card processor batches
+ <li>closed - books closed flag, empty or `Y'
+ </ul>
+ <li><a name="cust_bill_pay" href="man/FS/cust_bill_pay.html">cust_bill_pay</a> - Applicaton of a payment to a specific invoice.
+ <ul>
+ <li>billpaynum
+ <li>invnum - <a href="#cust_bill">invoice</a>
+ <li>paynum - <a href="#cust_pay">payment</a>
+ <li>amount
+ <li>_date
+ </ul>
+ <li><a name="cust_pay_batch" href="man/FS/cust_pay_batch.html">cust_pay_batch</a> - Pending batch
+ <ul>
+ <li>paybatchnum
+ <li>cardnum
+ <li>exp - card expiration
+ <li>amount
+ <li>invnum - <a href="#cust_bill">invoice</a>
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>payname - name on card
+ <li>first - name
+ <li>last - name
+ <li>address1
+ <li>address2
+ <li>city
+ <li>state
+ <li>zip
+ <li>country
+ </ul>
+ <li><a name="cust_pkg" href="man/FS/cust_pkg.html">cust_pkg</a> - Customer billing items
+ <ul>
+ <li>pkgnum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>pkgpart - <a href="#part_pkg">Package definition</a>
+ <li>setup - date
+ <li>bill - next bill date
+ <li>susp - (past) suspension date
+ <li>expire - (future) cancellation date
+ <li>cancel - (past) cancellation date
+ <li>otaker - order taker
+ <li>manual_flag - If this field is set to 1, disables the automatic unsuspensiond of this package when using the <a href="config.html#unsuspendauto">unsuspendauto</a> config file.
+ </ul>
+ <li><a name="cust_refund" href="man/FS/cust_refund.html">cust_refund</a> - Refunds. The transfer of money to a customer; equivalent to a negative <a href="#cust_pay">cust_pay</a> record.
+ <ul>
+ <li>refundnum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>refund - amount
+ <li>_date
+ <li>payby - CARD, BILL or COMP
+ <li>payinfo - card number, P.O.#, or comp issuer
+ <li>otaker - order taker
+ <li>closed - books closed flag, empty or `Y'
+ </ul>
+ <li><a name="cust_credit_refund" href="man/FS/cust_credit_refund.html">cust_credit_refund</a> - Applicaton of a refund to a specific credit.
+ <ul>
+ <li>creditrefundnum - primary key
+ <li>crednum - <a href="#cust_credit">credit</a>
+ <li>refundnum - <a href="#cust_refund">refund</a>
+ <li>amount
+ <li>_date
+ </ul>
+ <li><a name="cust_svc" href="man/FS/cust_svc.html">cust_svc</a> - Customer services
+ <ul>
+ <li>svcnum - primary key
+ <li>pkgnum - <a href="#cust_pkg">package</a>
+ <li>svcpart - <a href="#part_svc">Service definition</a>
+ </ul>
+ <li><a name="nas" href="man/FS/nas.html">nas</a> - Network Access Server (terminal server)
+ <ul>
+ <li>nasnum - primary key
+ <li>nas - NAS name
+ <li>nasip - NAS ip address
+ <li>nasfqdn - NAS fully-qualified domain name
+ <li>last - timestamp indicating the last instant the NAS was in a known state (used by the session monitoring).
+ </ul>
+ <li><a name="part_pkg" href="man/FS/part_pkg.html">part_pkg</a> - Package definitions
+ <ul>
+ <li>pkgpart - primary key
+ <li>pkg - package name
+ <li>comment - non-customer visable package comment
+ <li>setup - setup fee expression
+ <li>freq - recurring frequency (months)
+ <li>recur - recurring fee expression
+ <li>setuptax - Setup fee tax exempt flag, empty or `Y'
+ <li>recurtax - Recurring fee tax exempt flag, empty or `Y'
+ <li>plan - price plan
+ <li>plandata - additional price plan data
+ <li>disabled - Disabled flag, empty or `Y'
+ </ul>
+ <li><a name="part_referral" href="man/FS/part_referral.html">part_referral</a> - Referral listing
+ <ul>
+ <li>refnum - primary key
+ <li>referral - referral
+ </ul>
+ <li><a name="part_svc" href="man/FS/part_svc.html">part_svc</a> - Service definitions
+ <ul>
+ <li>svcpart - primary key
+ <li>svc - name of this service
+ <li>svcdb - table used for this service: svc_acct, svc_acct_sm, svc_forward, svc_domain, svc_charge or svc_wo
+ <li>disabled - Disabled flag, empty or `Y'
+<!-- <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_svc_column" href="man/FS/part_svc_column.html">part_svc_column</a>
+ <ul>
+ <li>columnnum - primary key
+ <li>svcpart - <a href="#part_svc">Service definition</a>
+ <li>columnname - column name in part_svc.svcdb table
+ <li>columnvalue - default or fixed value for the column
+ <li>columnflag - null, D or F
+ </ul>
+ <li><a name="pkg_svc" href="man/FS/pkg_svc.html">pkg_svc</a>
+ <ul>
+ <li>pkgpart - <a href="#part_pkg">Package definition</a>
+ <li>svcpart - <a href="#part_svc">Service definition</a>
+ <li>quantity - quantity of this service that this package includes
+ </ul>
+ <li><a name="export_svc" href="man/FS/export_svc.html">export_svc</a>
+ <ul>
+ <li>exportsvcnum - primary key
+ <li>svcpart - <a href="#part_svc">Service definition</a>
+ <li>exportnum - <a href="#exportnum">Export</a>
+ </ul>
+ <li><a name="part_export" href="man/FS/part_export.html">part_export</a> - Export to external provisioning
+ <ul>
+ <li>exportnum - primary key
+ <li>machine - Machine name
+ <li>exporttype - Export type
+ <li>nodomain - blank or Y: usernames are exported to this service with no domain
+ </ul>
+ <li><a name="part_export_option" href="man/FS/part_export_option.html">part_export_option</a> - provisioning options
+ <ul>
+ <li>optionnum - primary key
+ <li>exportnum - <a href="#part_export">Export</a>
+ <li>optionname - option name
+ <li>optionvalue - option value
+ </ul>
+ <li><a name="port" href="man/FS/port.html">port</a> - individual port on a <a href="#nas">nas</a>
+ <ul>
+ <li>portnum - primary key
+ <li>ip - IP address of this port
+ <li>nasport - port number on the NAS
+ <li>nasnum - <a href="#nas">NAS</a>
+ </ul>
+ <li><a name="prepay_credit" href="man/FS/prepay_credit.html">prepay_credit</a>
+ <ul>
+ <li>prepaynum - primary key
+ <li>identifier - text or numeric string used to receive this credit
+ <li>amount - amount of credit
+ </ul>
+ <li><a name="session" href="man/FS/session.html">session</a>
+ <ul>
+ <li>sessionnum - primary key
+ <li>portnum - <a href="#port">Port</a>
+ <li>svcnum - <a href="#svc_acct">Account</a>
+ <li>login - timestamp indicating the beginning of this user session.
+ <li>logout - timestamp indicating the end of this user session. May be null, which indicates a currently open session.
+ </ul>
+
+ <li><a name="svc_acct" href="man/FS/svc_acct.html">svc_acct</a> - Accounts
+ <ul>
+ <li>svcnum - <a href="#cust_svc">primary key</a>
+ <li>username
+ <li>_password
+ <li>sec_phrase - security phrase
+ <li>popnum - <a href="#svc_acct_pop">Point of Presence</a>
+ <li>uid
+ <li>gid
+ <li>finger - GECOS
+ <li>dir
+ <li>shell
+ <li>quota - (unimplementd)
+ <li>slipip - IP address
+ <li>seconds
+ <li>domsvc
+ <li>radius_<i>Radius_Reply_Attribute</i> - Radius-Reply-Attribute
+ <li>rc_<i>Radius_Check_Attribute</i> - Radius-Check-Attribute
+ </ul>
+ <li><a name="svc_acct_pop" href="man/FS/svc_acct_pop.html">svc_acct_pop</a> - Points of Presence
+ <ul>
+ <li>popnum - primary key
+ <li>city
+ <li>state
+ <li>ac - area code
+ <li>exch - exchange
+ <li>loc - rest of number
+ </ul>
+ <li><a name="part_pop_local" href="man/FS/part_pop_local.html">part_pop_local</a> - Local calling areas
+ <ul>
+ <li>localnum - primary key
+ <li>popnum - primary key
+ <li>city
+ <li>state
+ <li>npa - area code
+ <li>nxx - exchange
+ </ul>
+ <li><a name="svc_acct_sm" href="man/FS/svc_acct_sm.html">svc_acct_sm</a> - <b>DEPRECIATED</b> Domain mail aliases
+ <ul>
+ <li>svcnum - <a href="#cust_svc">primary key</a>
+ <li>domsvc - <a href="#svc_domain">Domain</a> (by svcnum)
+ <li>domuid - <a href="#svc_acct">Account</a> (by uid)
+ <li>domuser - domuser @ <a href="#svc_domain">Domain</a> forwards to <a href="#svc_acct">Account</a>
+ </ul>
+ <li><a name="svc_domain" href="man/FS/svc_domain.html">svc_domain</a> - Domains
+ <ul>
+ <li>svcnum - <a href="#cust_svc">primary key</a>
+ <li>domain
+ </ul>
+ <li><a name="svc_forward" href="man/FS/svc_forward.html">svc_forward</a> - Mail forwarding aliases
+ <ul>
+ <li>svcnum - <a href="#cust_svc">primary key</a>
+ <li>srcsvc - <a href="#svc_acct">svcnum of the source of this forward</a>
+ <li>dstsvc - <a href="#svc_acct">svcnum of the destination of this forward</a>
+ <li>dst - foreign destination (email address) - forward not local to freeside
+ </ul>
+ <li><a name="domain_record" href="man/FS/domain_record.html">domain_record</a> - Domain zone detail
+ <ul>
+ <li>recnum - primary key
+ <li>svcnum - <a href="#svc_domain">Domain</a> (by svcnum)
+ <li>reczone - zone for this line
+ <li>recaf - address family, usually <b>IN</b>
+ <li>rectype - type for this record (<b>A</b>, <b>MX</b>, etc.)
+ <li>recdata - data for this record
+ </ul>
+ <li><a name="svc_www" href="man/FS/svc_www.html">svc_www</a>
+ <ul>
+ <li>svcnum - <a href="#cust-svc">primary key</a>
+ <li>recnum - <a href="#domain_record">host</a>
+ <li>usersvc - <a href="#svc_acct">account</a>
+ </ul>
+ <li><a name="type_pkgs" href="man/FS/type_pkgs.html">type_pkgs</a>
+ <ul>
+ <li>typenum - <a href="#agent_type">agent type</a>
+ <li>pkgpart - <a href="#part_pkg">Package definition</a>
+ </ul>
+ <li><a name="queue" href="man/FS/queue.html">queue</a> - job queue
+ <ul>
+ <li>jobnum - primary key
+ <li>job
+ <li>_date
+ <li>status
+ <li>statustext
+ <li>svcnum
+ </ul>
+ <li><a name="queue_arg" href="man/FS/queue_arg.html">queue_arg</a> - job arguments
+ <ul>
+ <li>argnum - primary key
+ <li>jobnum - <a href="#queue">job</a>
+ <li>arg - argument
+ </ul>
+ <li><a name="queue_depend" href="man/FS/queue_depend.html">queue_depend</a> - job dependancies
+ <ul>
+ <li>dependnum - primary key
+ <li>jobnum - source jobnum
+ <li>depend_jobnum - dependancy jobnum
+ </ul>
+ <li><a name="radius_usergroup" href="man/FS/radius_usergroup.html">radius_usergroup</a> - Link users to RADIUS groups.
+ <ul>
+ <li>usergroupnum - primary key
+ <li>svcnum - <a href="#svc_acct">account</a>
+ <li>groupname
+ </ul>
+ <li><a name="msgcat" href="man/FS/msgcat.html">msgcat</a> - i18n message catalog
+ <ul>
+ <li>msgnum - primary key
+ <li>msgcode - message code
+ <li>locale - locale
+ <li>msg - Message text
+ </ul>
+ </ul>
+</body>
--- /dev/null
+<head>
+ <title>Session monitor</title>
+</head>
+<body>
+<h1>Session monitor</h1>
+<h2>Installation</h2>
+For security reasons, the client portion of the session montior may run on one
+or more external public machine(s). On these machines, install:
+<ul>
+ <li><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at l
+east 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series. Don't enable experimental features like threads or the PerlIO abstraction layer.)
+ <li><a href="man/FS/SessionClient.html">FS::SessionClient</a> (copy the fs_session/FS-SessionClient directory to the external machine, then: perl Makefile.PL; make; make install)
+</ul>
+Then:
+<ul>
+ <li>Add the user `freeside' to the the external machine.
+ <li>Create the /usr/local/freeside directory on the external machine (owned by the freeside user).
+ <li>touch /usr/local/freeside/fs_sessiond_socket; chown freeside /usr/local/freeside/fs_sessiond_socket; chmod 600 /usr/local/freeside/fs_sessiond_socket
+ <li>Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the external machine(s).
+ <li>Run <pre>fs_session_server <i>user</i> <i>machine</i></pre> on the Freeside machine.
+ <ul>
+ <li><i>user</i> is a user from the mapsecrets file.
+ <li><i>machine</i> is the name of the external machine.
+ </ul>
+</ul>
+<h2>Usage</h2>
+<ul>
+ <li>Web
+ <ul>
+ <li>Copy FS-SessionClient/cgi/login.cgi and logout.cgi to your web
+ server's document space.
+ <li>Use <a href="http://www.apache.org/docs/suexec.html">suEXEC</a> or <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">setuid</a> (see <a href="install.html">install.html</a> for details) to run login.cgi and logout.cgi as the freeside user.
+ </ul>
+ <li>Command-line
+ <br><pre>freeside-login username ( portnum | ip | nasnum nasport )
+freeside-logout username ( portnum | ip | nasnum nasport )</pre>
+ <ul>
+ <li><i>username</i> is a customer username from the svc_acct table
+ <li><i>portnum</i>, <i>ip</i> or <i>nasport</i> and <i>nasnum</i> uniquely identify a port in the <a href="schema.html#port">port</a> database table.
+ </ul>
+ <li>RADIUS
+ <ul>
+ <li>Configure your RADIUS server's login and logout callbacks to use the command-line <tt>freeside-login</tt> and <tt>freeside-logout</tt> utilites.
+ </ul>
+</ul>
+<h2>Callbacks</h2>
+<ul>
+ <li>Sesstion start - The command(s) specified in the <a href="config.html#session-start">session-start</a> configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
+ <li>Session end - The command(s) specified in the <a href="config.html#session-stop">session-stop</a> configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
+</ul>
+<h2>Dropping expired users</h2>
+Run <pre>bin/freeside-session-kill username</pre> periodically from cron.
+</body>
+</html>
--- /dev/null
+<head>
+ <title>Signup server</title>
+</head>
+<body>
+ <h1>Signup server</h1>
+For security reasons, the signup server should run on an external public
+webserver. On this machine, install:
+<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><a href="http://www.perl.com/CPAN/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series. Don't enable experimental features like threads or the PerlIO abstraction layer.)
+ <li><a href="http://search.cpan.org/search?dist=Text-Template">Text::Template</a>
+ <li><a href="http://search.cpan.org/search?dist=Storable">Storable</a>
+ <li><a href="http://search.cpan.org/search?dist=Business-CreditCard">Business-CreditCard</a>
+ <li><a href="http://www.sisd.com/useragent">HTTP::Headers::UserAgent</a> (version 2.0 or higher; not yet indexed correctly on CPAN)
+
+ <li><a href="man/FS/SignupClient.html">FS::SignupClient</a> (copy the fs_signup/FS-SignupClient directory to the external machine, then: perl Makefile.PL; make; make install)
+</ul>
+Then:
+<ul>
+ <li>Add the user `freeside' to the the external machine.
+ <li>Copy or symlink fs_signup/FS-SignupClient/cgi/signup.cgi into the web server's document space.
+ <li>When linking to signup.cgi, you can include a referring custnum in the URL as follows: <code>http://public.web.server/path/signup.cgi?ref=1542</code>
+ <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>Create the /usr/local/freeside directory on the external machine (owned by the freeside user).
+ <li>touch /usr/local/freeside/fs_signupd_socket; chown freeside /usr/local/freeside/fs_signupd_socket; chmod 600 /usr/local/freeside/fs_signupd_socket
+ <li>Use <a href="http://www.apache.org/docs/suexec.html">suEXEC</a> or <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">setuid</a> (see <a href="install.html">install.html</a> for details) to run signup.cgi as the freeside user.
+ <li>Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the external machine(s).
+ <li>Run <pre>fs_signup_server <i>user</i> <i>machine</i> <i>agentnum</i> <i>refnum</i></pre> on the Freeside machine.
+ <ul>
+ <li><i>user</i> is a user from the mapsecrets file.
+ <li><i>machine</i> is the name of the external machine.
+ <li><i>agentnum</i> and <i>refnum</i> are the <a href="schema.html#agent">agent</a> and <a href="schema.html#part_referral">referral</a>, respectively, to use for customers who sign up via this signup server.
+ </ul>
+</ul>
+Optional:
+<ul>
+ <li>If you create a <b>/usr/local/freeside/ieak.template</b> file on the external machine, it will be sent to IE users with MIME type <i>application/x-Internet-signup</i>. This file will be processed with <a href="http://search.cpan.org/doc/MJD/Text-Template-1.23/Template.pm">Text::Template</a> with the variables listed below available.
+ (an example file is included as <b>fs_signup/ieak.template</b>) See the <a href="http://www.microsoft.com/windows/ieak/techinfo/deploy/60/en/toc.asp">IEAK documentation</a> for more information.
+ <li>If you create a <b>/usr/local/freeside/cck.template</b> file on the external machine, the variables defined will be sent to Netscape users with MIME type <i>application/x-netscape-autoconfigure-dialer-v2</i>. This file will be processed with <a href="http://search.cpan.org/doc/MJD/Text-Template-1.23/Template.pm">Text::Template</a> with the variables listed below available.
+ (an example file is included as <b>fs_signup/cck.template</b>). See the <a href="http://help.netscape.com/products/client/mc/acctproc4.html">Netscape documentation</a> for more information.
+ <li>If you create a <b>/usr/local/freeside/success.html</b> file on the external machine, it will be used as the success HTML page. Although template substiutions are available, a regular HTML file will work fine here, unlike signup.html. An example file is included as <b>fs_signup/FS-SignupClient/cgi/success.html</b>
+ <li>Variable substitutions available in <b>ieak.template</b>, <b>cck.template</b> and <b>success.html</b>:
+ <ul>
+ <li>$ac - area code of selected POP
+ <li>$exch - exchange of selected POP
+ <li>$loc - local part of selected POP
+ <li>$username
+ <li>$password
+ <li>$email_name - first and last name
+ <li>$pkg - package name
+ </ul>
+ <li>If you create a <b>/usr/local/freeside/signup.html</b> file on the external machine, it will be used as a template for the form HTML. This requires the template to be constructed appropriately; probably best to start with the example file included as <b>fs_signup/FS-SignupClient/cgi/signup.html</b>.
+ <li>If there are any entries in the <i>prepay_credit</i> table, a user can enter a string matching the <b>identifier</i> column to receive the credit specified in the <b>amount</b> column, and/or the time specified in the <b>seconds</b> column (for use with the <a href="session.html">session monitor</a>), after which that <b>identifier</b> is no longer valid. This can be used to implement pre-paid "calling card" type signups. The <i>bin/generate-prepay</i> script can be used to populate the <i>prepay_credit</i> table.
+</ul>
+</body>
--- /dev/null
+<head>
+ <title>Troubleshooting</title>
+</head>
+<body>
+ <h1>Troubleshooting</h1>
+ <ul>
+ <li>When troubleshooting the web interface, helpful information is often in your web server's error log.
+ <li>If bin/svc_acct.import fails with an "Out of memory!" error using MySQL, upgrede MySQL and recompile the Perl DBD. There was a memory leak in some older versions of MySQL.
+ <li>If you get tons of errors in your web server's error log like this:
+<pre>
+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 errors like this:
+<pre>
+UID.pm: Can't open /var/spool/freeside/conf/secrets: Permission denied
+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 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>
--- /dev/null
+<head>
+ <title>Upgrading to 1.2.2</title>
+</head>
+<body>
+<h1>Upgrading to 1.2.2 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>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>Install the Perl modules <a href="http://www.perl.com/CPAN/modules/by-module/Locale/">Locale-Codes</a> and <a href="http://www.perl.com/CPAN/modules/by-module/Net/">Net-Whois</a>.
+ <li>Apply the following changes to your database:
+<pre>
+ALTER TABLE cust_pay_batch CHANGE exp exp VARCHAR(11);
+</pre>
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install</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.
+</body>
--- /dev/null
+<head>
+ <title>Upgrading to 1.3.0</title>
+</head>
+<body>
+<h1>Upgrading to 1.2.3 from 1.2.2</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>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>Apply the following changes to your database:
+<pre>
+ALTER TABLE svc_acct_pop ADD loc CHAR(4);
+CREATE TABLE prepay_credit (
+ prepaynum int NOT NULL,
+ identifier varchar(80) NOT NULL,
+ amount decimal(10,2) NOT NULL,
+ PRIMARY KEY (prepaynum),
+ INDEX (identifier)
+);
+</pre>
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install</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.
+</body>
--- /dev/null
+<head>
+ <title>Upgrading to 1.3.0</title>
+</head>
+<body>
+<h1>Upgrading to 1.3.0 from 1.2.3</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>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
+ <li>If migrating from less than 1.2.3, see these <a href="upgrade5.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>As 1.3.0 requires transactions, <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are no longer supported</b>. Converting to <a href="http://www.postgresql.org/">PostgreSQL</a> is recommended. If you really want to use MySQL, convert your tables to one of the <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>.
+ <li>Copy the <i>invoice_template</i> file from the <i>conf/</i> directory in the distribution to your <a href="config.html">configuration directory</a>.
+ <li>Install the <a href="http://search.cpan.org/search?dist=Text-Template">Text-Template</a>, <a href="http://search.cpan.org/search?dist=DBIx-DBSchema">DBIx-DBSchema</a>, <a href="http://search.cpan.org/search?dist=Net-SSH">Net-SSH</a>, <a href="http://search.cpan.org/search?dist=String-ShellQuote">String-ShellQuote</a> and <a href="http://search.cpan.org/search?dist=Net-SCP">Net-SCP</a> Perl modules.
+ <li>Apply the following changes to your database:
+<pre>
+CREATE TABLE domain_record (
+ recnum int NOT NULL,
+ svcnum int NOT NULL,
+ reczone varchar(80) NOT NULL,
+ recaf char(2) NOT NULL,
+ rectype char(5) NOT NULL,
+ recdata varchar(80) NOT NULL,
+ PRIMARY KEY (recnum)
+);
+CREATE TABLE svc_www (
+ svcnum int NOT NULL,
+ recnum int NOT NULL,
+ usersvc int NOT NULL,
+ PRIMARY KEY (svcnum)
+);
+ALTER TABLE part_svc ADD svc_www__recnum varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_www__recnum_flag char(1) NULL;
+ALTER TABLE part_svc ADD svc_www__usersvc varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_www__uesrsvc_flag char(1) NULL;
+ALTER TABLE svc_acct CHANGE _password _password varchar(50) NULL;
+ALTER TABLE svc_acct ADD seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds_flag char(1) NULL;
+ALTER TABLE prepay_credit ADD seconds integer NULL;
+
+</pre>
+ <li>If your database supports dropping columns:
+<pre>
+ALTER TABLE cust_bill DROP owed;
+ALTER TABLE cust_credit DROP credited;
+</pre>
+ Or, if your database does not support dropping columns, you can do this:
+<pre>
+ALTER TABLE cust_bill CHANGE owed depriciated decimal(10,2);
+ALTER TABLE cust_credit CHANGE credited depriciated2 decimal(10,2);
+</pre>
+
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Remove the symlink or directory <i>(your_site_perl_directory)</i>/FS.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install</pre>
+ <li>Run bin/dbdef-create.
+</body>
--- /dev/null
+<head>
+ <title>Upgrading to 1.3.1</title>
+</head>
+<body>
+<h1>Upgrading to 1.3.1 from 1.3.0</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>If migrating from less than 1.2.0, see these <a href="upgrade3.html">instructions</a> first.
+ <li>If migrating from less than 1.2.2, see these <a href="upgrade4.html">instructions</a> first.
+ <li>If migrating from less than 1.2.3, see these <a href="upgrade5.html">instructions</a> first.
+ <li>If migrating from less than 1.3.0, see these <a href="upgrade6.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>Copy or symlink htdocs to the new copy.
+ <li>Change to the FS directory in the new tarball, and build and install the
+ Perl modules:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install UNINST=1</pre>
+ <li>Run bin/dbdef-create.
+</body>
--- /dev/null
+<head>
+ <title>Upgrading to 1.4.0</title>
+</head>
+<body>
+<h1>Upgrading to 1.4.0 from 1.3.1</h1>
+<ul>
+ <li>If migrating from less than 1.3.1, see these <a href="upgrade7.html">instructions</a> first.
+ <li><font size="+2" color="#ff0000">Backup your database and current Freeside installation.</font> (with <a href="http://www.ca.postgresql.org/devel-corner/docs/postgres/backup.html">PostgreSQL</a>) (with <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Backup">MySQL</a>)
+ <li><a href="http://perl.apache.org/">mod_perl</a> is now required.
+ <li>Install <a href="http://search.cpan.org/search?dist=Time-Duration">Time-Duration</a>, <a href="http://search.cpan.org/search?dist=Tie-IxHash">Tie-IxHash</a> and <a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a>.
+ <li>Install <a href="http://www.apache-asp.org/">Apache::ASP</a> or <a href="http://www.masonhq.com/">HTML::Mason</a>.
+ <li>Install <a href="http://rsync.samba.org/">rsync</a>
+</ul>
+<table>
+ <tr>
+ <th>Apache::ASP</th><th>Mason</th>
+ </tr>
+ <tr>
+ <td><ul>
+ <li>Run <tt>make aspdocs</tt>
+ <li>Copy <tt>aspdocs/</tt> to your web server's document space.
+ <li>Create a <a href="http://www.apache-asp.org/config.html#Global">Global</a> directory, such as <tt>/usr/local/etc/freeside/asp-global/</tt>
+ <li>Copy <tt>htetc/global.asa</tt> to the Global directory.
+ <li>Configure Apache for the Global directory and to execute .cgi files using Apache::ASP. For example:
+<font size="-1"><pre>
+<Directory /usr/local/apache/htdocs/freeside-asp>
+<Files ~ (\.cgi)>
+AddHandler perl-script .cgi
+PerlHandler Apache::ASP
+</Files>
+<Perl>
+$MLDBM::RemoveTaint = 1;
+</Perl>
+PerlSetVar Global /usr/local/etc/freeside/asp-global/
+</Directory>
+</pre></font>
+ </ul></td>
+ <td><ul>
+ <li>Run <tt>make masondocs</tt>
+ <li>Copy <tt>masondocs/</tt> to your web server's document space.
+ <li>Copy <tt>htetc/handler.pl</tt> to your web server's configuration directory.
+ <li>Edit <tt>handler.pl</tt> and set an appropriate <tt>data_dir</tt>, such as <tt>/usr/local/etc/freeside/mason-data</tt>
+ <li>Configure Apache to use the <tt>handler.pl</tt> file and to execute .cgi files using HTML::Mason. For example:
+<font size="-1"><pre>
+<Directory /usr/local/apache/htdocs/freeside-mason>
+<Files ~ (\.cgi)>
+AddHandler perl-script .cgi
+PerlHandler HTML::Mason
+</Files>
+<Perl>
+require "/usr/local/apache/conf/handler.pl";
+</Perl>
+</Directory>
+</pre></font>
+ </ul></td>
+ </tr>
+</table>
+<ul>
+ <li>Build and install the Perl modules:
+ <pre>
+$ su
+# make install-perl-modules</pre>
+ <li>Apply the following changes to your database:
+<pre>
+CREATE TABLE svc_forward (
+ svcnum int NOT NULL,
+ srcsvc int NOT NULL,
+ dstsvc int NOT NULL,
+ dst varchar(80),
+ PRIMARY KEY (svcnum)
+);
+
+CREATE TABLE cust_credit_bill (
+ creditbillnum int primary key,
+ crednum int not null,
+ invnum int not null,
+ _date int not null,
+ amount decimal(10,2) not null
+);
+
+CREATE TABLE cust_bill_pay (
+ billpaynum int primary key,
+ invnum int not null,
+ paynum int not null,
+ _date int not null,
+ amount decimal(10,2) not null
+);
+
+CREATE TABLE cust_credit_refund (
+ creditrefundnum int primary key,
+ crednum int not null,
+ refundnum int not null,
+ _date int not null,
+ amount decimal(10,2) not null
+);
+
+CREATE TABLE part_svc_column (
+ columnnum int primary key,
+ svcpart int not null,
+ columnname varchar(64) not null,
+ columnvalue varchar(80) null,
+ columnflag char(1) null
+);
+
+CREATE TABLE queue (
+ jobnum int primary key,
+ job text not null,
+ _date int not null,
+ status varchar(80) not null,
+ statustext text null,
+ svcnum int null
+);
+CREATE INDEX queue1 ON queue ( svcnum );
+CREATE INDEX queue2 ON queue ( status );
+
+CREATE TABLE queue_arg (
+ argnum int primary key,
+ jobnum int not null,
+ arg text null
+);
+CREATE INDEX queue_arg1 ON queue_arg ( jobnum );
+
+CREATE TABLE queue_depend (
+ dependnum int primary key,
+ jobnum int not null,
+ depend_jobnum int not null
+);
+CREATE INDEX queue_depend1 ON queue_depend ( jobnum );
+CREATE INDEX queue_depend2 ON queue_depend ( depend_jobnum );
+
+CREATE TABLE part_pop_local (
+ localnum int primary key,
+ popnum int not null,
+ city varchar(80) null,
+ state char(2) null,
+ npa char(3) not null,
+ nxx char(3) not null
+);
+CREATE UNIQUE INDEX part_pop_local1 ON part_pop_local ( npa, nxx );
+
+CREATE TABLE cust_bill_event (
+ eventnum int primary key,
+ invnum int not null,
+ eventpart int not null,
+ _date int not null
+);
+CREATE UNIQUE INDEX cust_bill_event1 ON cust_bill_event ( eventpart, invnum );
+CREATE INDEX cust_bill_event2 ON cust_bill_event ( invnum );
+
+CREATE TABLE part_bill_event (
+ eventpart int primary key,
+ payby char(4) not null,
+ event varchar(80) not null,
+ eventcode text null,
+ seconds int null,
+ weight int not null,
+ plan varchar(80) null,
+ plandata text null,
+ disabled char(1) null
+);
+CREATE INDEX part_bill_event1 ON part_bill_event ( payby );
+
+CREATE TABLE export_svc (
+ exportsvcnum int primary key,
+ exportnum int not null,
+ svcpart int not null
+);
+CREATE UNIQUE INDEX export_svc1 ON export_svc ( exportnum, svcpart );
+CREATE INDEX export_svc2 ON export_svc ( exportnum );
+CREATE INDEX export_svc3 ON export_svc ( svcpart );
+
+CREATE TABLE part_export (
+ exportnum int primary key,
+ machine varchar(80) not null,
+ exporttype varchar(80) not null,
+ nodomain char(1) NULL
+);
+CREATE INDEX part_export1 ON part_export ( machine );
+CREATE INDEX part_export2 ON part_export ( exporttype );
+
+CREATE TABLE part_export_option (
+ optionnum int primary key,
+ exportnum int not null,
+ optionname varchar(80) not null,
+ optionvalue text NULL
+);
+CREATE INDEX part_export_option1 ON part_export_option ( exportnum );
+CREATE INDEX part_export_option2 ON part_export_option ( optionname );
+
+CREATE TABLE radius_usergroup (
+ usergroupnum int primary key,
+ svcnum int not null,
+ groupname varchar(80) not null
+);
+CREATE INDEX radius_usergroup1 ON radius_usergroup ( svcnum );
+CREATE INDEX radius_usergroup2 ON radius_usergroup ( groupname );
+
+CREATE TABLE msgcat (
+ msgnum int primary key,
+ msgcode varchar(80) not null,
+ locale varchar(16) not null,
+ msg text not null
+);
+CREATE INDEX msgcat1 ON msgcat ( msgcode, locale );
+
+CREATE TABLE cust_tax_exempt (
+ exemptnum int primary key,
+ custnum int not null,
+ taxnum int not null,
+ year int not null,
+ month int not null,
+ amount decimal(10,2)
+);
+CREATE UNIQUE INDEX cust_tax_exempt1 ON cust_tax_exempt ( taxnum, year, month );
+
+ALTER TABLE svc_acct ADD domsvc integer NOT NULL;
+ALTER TABLE svc_domain ADD catchall integer NULL;
+ALTER TABLE cust_main ADD referral_custnum integer NULL;
+ALTER TABLE cust_pay ADD custnum integer;
+ALTER TABLE cust_pay_batch ADD paybatchnum integer;
+ALTER TABLE cust_refund ADD custnum integer;
+ALTER TABLE cust_pkg ADD manual_flag char(1) NULL;
+ALTER TABLE part_pkg ADD plan varchar(80) NULL;
+ALTER TABLE part_pkg ADD plandata text NULL;
+ALTER TABLE part_pkg ADD setuptax char(1) NULL;
+ALTER TABLE part_pkg ADD recurtax char(1) NULL;
+ALTER TABLE part_pkg ADD disabled char(1) NULL;
+ALTER TABLE part_svc ADD disabled char(1) NULL;
+ALTER TABLE cust_bill ADD closed char(1) NULL;
+ALTER TABLE cust_pay ADD closed char(1) NULL;
+ALTER TABLE cust_credit ADD closed char(1) NULL;
+ALTER TABLE cust_refund ADD closed char(1) NULL;
+ALTER TABLE cust_bill_event ADD status varchar(80);
+ALTER TABLE cust_bill_event ADD statustext text NULL;
+ALTER TABLE svc_acct ADD sec_phrase varchar(80) NULL;
+ALTER TABLE part_pkg ADD taxclass varchar(80) NULL;
+ALTER TABLE cust_main_county ADD taxclass varchar(80) NULL;
+ALTER TABLE cust_main_county ADD exempt_amount decimal(10,2);
+CREATE INDEX cust_main3 ON cust_main ( referral_custnum );
+CREATE INDEX cust_credit_bill1 ON cust_credit_bill ( crednum );
+CREATE INDEX cust_credit_bill2 ON cust_credit_bill ( invnum );
+CREATE INDEX cust_bill_pay1 ON cust_bill_pay ( invnum );
+CREATE INDEX cust_bill_pay2 ON cust_bill_pay ( paynum );
+CREATE INDEX cust_credit_refund1 ON cust_credit_refund ( crednum );
+CREATE INDEX cust_credit_refund2 ON cust_credit_refund ( refundnum );
+CREATE UNIQUE INDEX cust_pay_batch_pkey ON cust_pay_batch ( paybatchnum );
+CREATE UNIQUE INDEX part_svc_column1 ON part_svc_column ( svcpart, columnname );
+CREATE INDEX cust_pay2 ON cust_pay ( paynum );
+CREATE INDEX cust_pay3 ON cust_pay ( custnum );
+CREATE INDEX cust_pay4 ON cust_pay ( paybatch );
+</pre>
+
+ <li>If you are using PostgreSQL, apply the following changes to your database:
+<pre>
+CREATE UNIQUE INDEX agent_pkey ON agent ( agentnum );
+CREATE UNIQUE INDEX agent_type_pkey ON agent_type ( typenum );
+CREATE UNIQUE INDEX cust_bill_pkey ON cust_bill ( invnum );
+CREATE UNIQUE INDEX cust_credit_pkey ON cust_credit ( crednum );
+CREATE UNIQUE INDEX cust_main_pkey ON cust_main ( custnum );
+CREATE UNIQUE INDEX cust_main_county_pkey ON cust_main_county ( taxnum );
+CREATE UNIQUE INDEX cust_main_invoice_pkey ON cust_main_invoice ( destnum );
+CREATE UNIQUE INDEX cust_pay_pkey ON cust_pay ( paynum );
+CREATE UNIQUE INDEX cust_pkg_pkey ON cust_pkg ( pkgnum );
+CREATE UNIQUE INDEX cust_refund_pkey ON cust_refund ( refundnum );
+CREATE UNIQUE INDEX cust_svc_pkey ON cust_svc ( svcnum );
+CREATE UNIQUE INDEX domain_record_pkey ON domain_record ( recnum );
+CREATE UNIQUE INDEX nas_pkey ON nas ( nasnum );
+CREATE UNIQUE INDEX part_pkg_pkey ON part_pkg ( pkgpart );
+CREATE UNIQUE INDEX part_referral_pkey ON part_referral ( refnum );
+CREATE UNIQUE INDEX part_svc_pkey ON part_svc ( svcpart );
+CREATE UNIQUE INDEX port_pkey ON port ( portnum );
+CREATE UNIQUE INDEX prepay_credit_pkey ON prepay_credit ( prepaynum );
+CREATE UNIQUE INDEX session_pkey ON session ( sessionnum );
+CREATE UNIQUE INDEX svc_acct_pkey ON svc_acct ( svcnum );
+CREATE UNIQUE INDEX svc_acct_pop_pkey ON svc_acct_pop ( popnum );
+CREATE UNIQUE INDEX svc_acct_sm_pkey ON svc_acct_sm ( svcnum );
+CREATE UNIQUE INDEX svc_domain_pkey ON svc_domain ( svcnum );
+CREATE UNIQUE INDEX svc_www_pkey ON svc_www ( svcnum );
+CREATE UNIQUE INDEX type_pkgs_pkey ON type_pkgs ( typenum );
+</pre>
+ <li>If you wish to enable service/shipping addresses, apply the following
+ changes to your database:
+<pre>
+ALTER TABLE cust_main ADD COLUMN ship_last varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_first varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_company varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_address1 varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_address2 varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_city varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_county varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_state varchar(80) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_zip varchar(10) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_country char(2) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_daytime varchar(20) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_night varchar(20) NULL;
+ALTER TABLE cust_main ADD COLUMN ship_fax varchar(12) NULL;
+CREATE INDEX cust_main1 ON cust_main ( ship_last );
+CREATE INDEX cust_main2 ON cust_main ( ship_company );
+</pre>
+ <li>If you wish to enable customer comments, apply the following change to
+ your database:
+<pre>
+ALTER TABLE cust_main ADD COLUMN comments text NULL;
+</pre>
+ <li>If you are using the signup server, reinstall it according to the <a href="signup.html">instructions</a>. The 1.3.x signup server is not compatible with 1.4.x.
+ <li>Run bin/dbdef-create.
+ <li>If you have svc_acct_sm records or service definitions:
+ <ul>
+ <li>Create a service definition with table svc_forward
+ <li>Run bin/fs-migrate-svc_acct_sm
+ </ul>
+ <li>Run bin/fs-migrate-payref
+ <li>Run bin/fs-migrate-part_svc
+ <li><b>After running bin/fs-migrate-payref</b>, apply the following changes to your database:
+ <table border><tr><th>PostgreSQL</th><th>MySQL, others</th></tr>
+<tr><td>
+<font size=-1><pre>
+CREATE TABLE cust_pay_temp (
+ paynum int primary key,
+ custnum int not null,
+ paid decimal(10,2) not null,
+ _date int null,
+ payby char(4) not null,
+ payinfo varchar(16) null,
+ paybatch varchar(80) null
+);
+INSERT INTO cust_pay_temp SELECT * from cust_pay;
+DROP TABLE cust_pay;
+ALTER TABLE cust_pay_temp RENAME TO cust_pay;
+CREATE UNIQUE INDEX cust_pay1 ON cust_pay (paynum);
+CREATE TABLE cust_refund_temp (
+ refundnum int primary key,
+ custnum int not null,
+ _date int null,
+ refund decimal(10,2) not null,
+ otaker varchar(8) not null,
+ reason varchar(80) not null,
+ payby char(4) not null,
+ payinfo varchar(16) null,
+ paybatch varchar(80) null
+);
+INSERT INTO cust_refund_temp SELECT * from cust_refund;
+DROP TABLE cust_refund;
+ALTER TABLE cust_refund_temp RENAME TO cust_refund;
+CREATE UNIQUE INDEX cust_refund1 ON cust_refund (refundnum);
+</pre></font>
+</td><td>
+<font size=-1><pre>
+ALTER TABLE cust_pay DROP COLUMN invnum;
+ALTER TABLE cust_refund DROP COLUMN crednum;
+</pre></font>
+</td></tr></table>
+ <li><b>IMPORTANT: After applying the second set of database changes</b>, run bin/dbdef-create again.
+ <li><b>IMPORTANT</b>: run bin/create-history-tables
+ <li><b>IMPORTANT: After running bin/create-history-tables</b>, run bin/dbdef-create again.
+ <li>As the freeside UNIX user, run <tt>bin/populate-msgcat <b>username</b></tt
+> to populate the message catalog, passing the username of a Freeside user you c
+reated above:
+<pre>
+$ su freeside
+$ bin/populate-msgcat <b>username</b>
+</pre>
+ <li>set the <a href="../config/config.cgi#username_policy">user_policy configuration value</a> as appropriate for your site.
+ <li>set the <a href="../config/config.cgi#locale">locale configuration value</a> to en_US.
+ <li>the mxmachines, nsmachines, arecords and cnamerecords configuration values have been deprecated. Set the <a href="../config/config.cgi#defaultrecords">defaultrecords configuration value</a> instead.
+ <li>Create the `/usr/local/etc/freeside/cache.<i>datasrc</i>' directory
+ (owned by the freeside user).
+ <li>freeside-queued was installed with the Perl modules. Start it now and ensure that is run upon system startup.
+ <li>Set appropriate <a href="../browse/part_bill_event.cgi">invoice events</a> for your site. At the very least, you'll want to set some invoice events "<i>After 0 days</i>": a <i>BILL</i> invoice event to print invoices, a <i>CARD</i> invoice event to batch or run cards real-time, and a <i>COMP</i> invoice event to "pay" complimentary customers. If you were using the <i>-i</i> option to <a href="man/bin/freeside-bill.html">freeside-bill</a> it should be removed.
+ <li>Use <a href="man/bin/freeside-daily.html">freeside-daily</a> instead of <a href="man/bin/freeside-bill.html">freeside-bill</a>.
+ <li>If you would like Freeside to notify your customers when their credit
+ cards and other billing arrangements are about to expire, arrange for
+ <b>freeside-expiration-alerter</b> to be run daily by cron or similar
+ facility. The message it sends can be configured from the
+ <u>Configuration</u> choice of the main menu as <u>alerter_template</u>.
+ <li>Export has been rewritten. If you were using the icradiusmachines,
+ icradius_mysqldest, icradius_mysqlsource, or icradius_secrets files, add
+ an appropriate "sqlradius" export to all relevant Service Definitions
+ instead. Use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or
+ point the "sqlradius" export directly at your external ICRADIUS or FreeRADIUS
+ database (or through an SSL-necrypting proxy...)
+</ul>
+</body>
--- /dev/null
+<!-- mason kludge -->
+<%
+# <!-- $Id: REAL_cust_pkg.cgi,v 1.3 2002-04-23 07:32:49 ivan Exp $ -->
+
+my $error ='';
+my $pkgnum = '';
+if ( $cgi->param('error') ) {
+ $error = $cgi->param('error');
+ $pkgnum = $cgi->param('pkgnum');
+} else {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/ or die "no pkgnum";
+ $pkgnum = $1;
+}
+
+#get package record
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+die "No package!" unless $cust_pkg;
+my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
+
+if ( $error ) {
+ #$cust_pkg->$_(str2time($cgi->param($_)) foreach qw(setup bill);
+ $cust_pkg->setup(str2time($cgi->param('setup')));
+ $cust_pkg->bill(str2time($cgi->param('bill')));
+}
+
+#my $custnum = $cust_pkg->getfield('custnum');
+print header('Package Edit'); #, menubar(
+# "View this customer (#$custnum)" => popurl(2). "view/cust_main.cgi?$custnum",
+# 'Main Menu' => popurl(2)
+#));
+
+#print info
+my($susp,$cancel,$expire)=(
+ $cust_pkg->getfield('susp'),
+ $cust_pkg->getfield('cancel'),
+ $cust_pkg->getfield('expire'),
+);
+my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
+my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
+my $otaker = $cust_pkg->getfield('otaker');
+
+print '<FORM NAME="formname" ACTION="process/REAL_cust_pkg.cgi" METHOD="POST">', qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: $error</FONT>!
+ if $error;
+
+print &ntable("#cccccc"), '<TR><TD>', &ntable("#cccccc",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">Order taker</TD><TD BGCOLOR="#ffffff">',
+ $otaker, '</TD></TR>',
+ '<TR><TD ALIGN="right">Setup date</TD><TD>'.
+ '<INPUT TYPE="text" NAME="setup" SIZE=32 VALUE="',
+ ( $setup ? time2str("%c %z (%Z)",$setup) : "" ), '"></TD></TR>',
+ '<TR><TD ALIGN="right">Next bill date</TD><TD>',
+ '<INPUT TYPE="text" NAME="bill" SIZE=32 VALUE="',
+ ( $bill ? time2str("%c %z (%Z)",$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;
+
+%>
+</TABLE></TD></TR></TABLE>
+<BR><INPUT TYPE="submit" VALUE="Apply Changes">
+</FORM>
+</BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $agent;
+if ( $cgi->param('error') ) {
+ $agent = new FS::agent ( {
+ map { $_, scalar($cgi->param($_)) } fields('agent')
+ } );
+} elsif ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $agent = qsearchs( 'agent', { 'agentnum' => $1 } );
+} else { #adding
+ $agent = new FS::agent {};
+}
+my $action = $agent->agentnum ? 'Edit' : 'Add';
+my $hashref = $agent->hashref;
+
+print header("$action Agent", menubar(
+ 'Main Menu' => $p,
+ 'View all agents' => $p. 'browse/agent.cgi',
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/agent.cgi" METHOD=POST>',
+ qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
+ "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
+
+print &ntable("#cccccc", 2, ''), <<END;
+<TR>
+ <TH ALIGN="right">Agent</TH>
+ <TD><INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}"></TD>
+</TR>
+<TR>
+ <TH ALIGN="right">Agent type</TH>
+ <TD><SELECT NAME="typenum" SIZE=1>
+END
+
+foreach my $agent_type (qsearch('agent_type',{})) {
+ print "<OPTION VALUE=". $agent_type->typenum;
+ print " SELECTED"
+ if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum );
+ print ">", $agent_type->getfield('typenum'), ": ",
+ $agent_type->getfield('atype'),"\n";
+}
+
+print <<END;
+</SELECT></TD>
+</TR>
+<TR>
+ <TD ALIGN="right"><!--Frequency--></TD>
+ <TD><INPUT TYPE="hidden" NAME="freq" VALUE="$hashref->{freq}"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right"><!--Program--></TD>
+ <TD><INPUT TYPE="hidden" NAME="prog" VALUE="$hashref->{prog}"></TD>
+</TR>
+</TABLE>
+END
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{agentnum} ? "Apply changes" : "Add agent",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($agent_type);
+if ( $cgi->param('error') ) {
+ $agent_type = new FS::agent_type ( {
+ map { $_, scalar($cgi->param($_)) } fields('agent')
+ } );
+} elsif ( $cgi->keywords ) { #editing
+ my( $query ) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $agent_type=qsearchs('agent_type',{'typenum'=>$1});
+} else { #adding
+ $agent_type = new FS::agent_type {};
+}
+my $action = $agent_type->typenum ? 'Edit' : 'Add';
+my $hashref = $agent_type->hashref;
+
+print header("$action Agent Type", menubar(
+ 'Main Menu' => "$p",
+ 'View all agent types' => "${p}browse/agent_type.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/agent_type.cgi" METHOD=POST>',
+ qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
+ "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)";
+
+print <<END;
+<BR><BR>Agent Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}">
+<BR><BR>Select which packages agents of this type may sell to customers<BR>
+END
+
+foreach my $part_pkg ( qsearch('part_pkg',{ 'disabled' => '' }) ) {
+ print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
+ $part_pkg->getfield('pkgpart'), qq!" !,
+ # ( 'CHECKED 'x scalar(
+ qsearchs('type_pkgs',{
+ 'typenum' => $agent_type->getfield('typenum'),
+ 'pkgpart' => $part_pkg->getfield('pkgpart'),
+ })
+ ? 'CHECKED '
+ : '',
+ qq!VALUE="ON"> !,
+ qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart,
+ '">', $part_pkg->pkgpart. ": ". $part_pkg->getfield('pkg'), '</A>',
+ ;
+}
+
+print qq!<BR><BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{typenum} ? "Apply changes" : "Add agent type",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($paynum, $amount, $invnum);
+if ( $cgi->param('error') ) {
+ $paynum = $cgi->param('paynum');
+ $amount = $cgi->param('amount');
+ $invnum = $cgi->param('invnum');
+} else {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $paynum = $1;
+ $amount = '';
+ $invnum = '';
+}
+
+my $otaker = getotaker;
+
+my $p1 = popurl(1);
+
+print header("Apply Payment", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT><BR><BR>"
+ if $cgi->param('error');
+print <<END;
+ <FORM ACTION="${p1}process/cust_bill_pay.cgi" METHOD=POST>
+END
+
+my $cust_pay = qsearchs('cust_pay', { 'paynum' => $paynum } );
+die "payment $paynum not found!" unless $cust_pay;
+
+my $unapplied = $cust_pay->unapplied;
+
+print "Payment # <B>$paynum</B>".
+ qq!<INPUT TYPE="hidden" NAME="paynum" VALUE="$paynum">!.
+ '<BR>Date: <B>'. time2str("%D", $cust_pay->_date). '</B>'.
+ '<BR>Amount: $<B>'. $cust_pay->paid. '</B>'.
+ "<BR>Unapplied amount: \$<B>$unapplied</B>"
+ ;
+
+my @cust_bill = grep $_->owed != 0,
+ qsearch('cust_bill', { 'custnum' => $cust_pay->custnum } );
+
+print <<END;
+<SCRIPT>
+function changed(what) {
+ cust_bill = what.options[what.selectedIndex].value;
+END
+
+foreach my $cust_bill ( @cust_bill ) {
+ my $invnum = $cust_bill->invnum;
+ my $changeto = $cust_bill->owed < $unapplied
+ ? $cust_bill->owed
+ : $unapplied;
+ print <<END;
+ if ( cust_bill == $invnum ) {
+ what.form.amount.value = "$changeto";
+ }
+END
+}
+
+#print <<END;
+# if ( cust_bill == "Refund" ) {
+# what.form.amount.value = "$credited";
+# }
+#}
+#</SCRIPT>
+#END
+print "</SCRIPT>\n";
+
+print qq!<BR>Invoice #<SELECT NAME="invnum" SIZE=1 onChange="changed(this)">!,
+ '<OPTION VALUE="">';
+foreach my $cust_bill ( @cust_bill ) {
+ print '<OPTION'. ( $cust_bill->invnum eq $invnum ? ' SELECTED' : '' ).
+ ' VALUE="'. $cust_bill->invnum. '">'. $cust_bill->invnum.
+ ' - '. time2str("%D",$cust_bill->_date).
+ ' - $'. $cust_bill->owed;
+}
+#print qq!<OPTION VALUE="Refund">Refund!;
+print "</SELECT>";
+
+print qq!<BR>Amount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
+
+print <<END;
+<BR>
+<INPUT TYPE="submit" VALUE="Apply">
+END
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my($custnum, $amount, $reason);
+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 {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $custnum = $1;
+ $amount = '';
+ #$refund = 'yes';
+ $reason = '';
+}
+my $_date = time;
+
+my $otaker = getotaker;
+
+my $p1 = popurl(1);
+
+print header("Post Credit", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+print <<END, small_custview($custnum, $conf->config('countrydefault'));
+ <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST>
+ <INPUT TYPE="hidden" NAME="crednum" VALUE="">
+ <INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">
+ <INPUT TYPE="hidden" NAME="paybatch" VALUE="">
+ <INPUT TYPE="hidden" NAME="_date" VALUE="$_date">
+ <INPUT TYPE="hidden" NAME="credited" VALUE="">
+ <INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">
+END
+
+print '<BR><BR>Credit'. ntable("#cccccc", 2).
+ '<TR><TD ALIGN="right">Date</TD><TD BGCOLOR="#ffffff">'.
+ time2str("%D",$_date). '</TD></TR>';
+
+print qq!<TR><TD ALIGN="right">Amount</TD><TD BGCOLOR="#ffffff">\$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8></TD></TR>!;
+
+#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!;
+
+print qq!<TR><TD ALIGN="right">Reason</TD><TD BGCOLOR="#ffffff"><INPUT TYPE="text" NAME="reason" VALUE="$reason"></TD></TR>!;
+
+print qq!<TR><TD ALIGN="right">Auto-apply<BR>to invoices</TD><TD><SELECT NAME="apply"><OPTION VALUE="yes" SELECTED>yes<OPTION>no</SELECT></TD>!;
+
+print <<END;
+</TABLE>
+<BR>
+<INPUT TYPE="submit" VALUE="Post credit">
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($crednum, $amount, $invnum);
+if ( $cgi->param('error') ) {
+ #$cust_credit_bill = new FS::cust_credit_bill ( {
+ # map { $_, scalar($cgi->param($_)) } fields('cust_credit_bill')
+ #} );
+ $crednum = $cgi->param('crednum');
+ $amount = $cgi->param('amount');
+ #$refund = $cgi->param('refund');
+ $invnum = $cgi->param('invnum');
+} else {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $crednum = $1;
+ $amount = '';
+ #$refund = 'yes';
+ $invnum = '';
+}
+
+my $otaker = getotaker;
+
+my $p1 = popurl(1);
+
+print header("Apply Credit", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT><BR><BR>"
+ if $cgi->param('error');
+print <<END;
+ <FORM ACTION="${p1}process/cust_credit_bill.cgi" METHOD=POST>
+END
+
+my $cust_credit = qsearchs('cust_credit', { 'crednum' => $crednum } );
+die "credit $crednum not found!" unless $cust_credit;
+
+my $credited = $cust_credit->credited;
+
+print "Credit # <B>$crednum</B>".
+ qq!<INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!.
+ '<BR>Date: <B>'. time2str("%D", $cust_credit->_date). '</B>'.
+ '<BR>Amount: $<B>'. $cust_credit->amount. '</B>'.
+ "<BR>Unapplied amount: \$<B>$credited</B>".
+ '<BR>Reason: <B>'. $cust_credit->reason. '</B>'
+ ;
+
+my @cust_bill = grep $_->owed != 0,
+ qsearch('cust_bill', { 'custnum' => $cust_credit->custnum } );
+
+print <<END;
+<SCRIPT>
+function changed(what) {
+ cust_bill = what.options[what.selectedIndex].value;
+END
+
+foreach my $cust_bill ( @cust_bill ) {
+ my $invnum = $cust_bill->invnum;
+ my $changeto = $cust_bill->owed < $cust_credit->credited
+ ? $cust_bill->owed
+ : $cust_credit->credited;
+ print <<END;
+ if ( cust_bill == $invnum ) {
+ what.form.amount.value = "$changeto";
+ }
+END
+}
+
+print <<END;
+ if ( cust_bill == "Refund" ) {
+ what.form.amount.value = "$credited";
+ }
+}
+</SCRIPT>
+END
+
+print qq!<BR>Invoice #<SELECT NAME="invnum" SIZE=1 onChange="changed(this)">!,
+ '<OPTION VALUE="">';
+foreach my $cust_bill ( @cust_bill ) {
+ print '<OPTION'. ( $cust_bill->invnum eq $invnum ? ' SELECTED' : '' ).
+ ' VALUE="'. $cust_bill->invnum. '">'. $cust_bill->invnum.
+ ' - '. time2str("%D",$cust_bill->_date).
+ ' - $'. $cust_bill->owed;
+}
+print qq!<OPTION VALUE="Refund">Refund!;
+print "</SELECT>";
+
+print qq!<BR>Amount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
+
+print <<END;
+<BR>
+<INPUT TYPE="submit" VALUE="Apply">
+END
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+ #for misplaced logic below
+ #use FS::part_pkg;
+
+ #for false laziness below (now more properly lazy)
+ #use FS::svc_acct_pop;
+
+ #for (other) false laziness below
+ #use FS::agent;
+ #use FS::type_pkgs;
+
+my $conf = new FS::Conf;
+
+#get record
+
+my $error = '';
+my($custnum, $username, $password, $popnum, $cust_main, $saved_pkgpart);
+if ( $cgi->param('error') ) {
+ $error = $cgi->param('error');
+ $cust_main = new FS::cust_main ( {
+ map { $_, scalar($cgi->param($_)) } fields('cust_main')
+ } );
+ $custnum = $cust_main->custnum;
+ $saved_pkgpart = $cgi->param('pkgpart_svcpart') || '';
+ if ( $saved_pkgpart =~ /^(\d+)_/ ) {
+ $saved_pkgpart = $1;
+ } else {
+ $saved_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 } );
+ $saved_pkgpart = 0;
+ $username = '';
+ $password = '';
+ $popnum = 0;
+} else {
+ $custnum='';
+ $cust_main = new FS::cust_main ( {} );
+ $cust_main->otaker( &getotaker );
+ $cust_main->referral_custnum( $cgi->param('referral_custnum') );
+ $saved_pkgpart = 0;
+ $username = '';
+ $password = '';
+ $popnum = 0;
+}
+$cgi->delete_all();
+my $action = $custnum ? 'Edit' : 'Add';
+
+# top
+
+my $p1 = popurl(1);
+print header("Customer $action", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $error, "</FONT>"
+ if $error;
+
+print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST NAME="form1">!,
+ qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
+ qq!Customer # !, ( $custnum ? "<B>$custnum</B>" : " (NEW)" ),
+
+;
+
+# agent
+
+my $r = qq!<font color="#ff0000">*</font> !;
+
+my @agents = qsearch( 'agent', {} );
+#die "No agents created!" unless @agents;
+die "You have not created any agents. You must create at least one agent before adding a customer. Go to ". popurl(2). "browse/agent.cgi and create one or more agents." unless @agents;
+my $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->agent;
+ #">", $agent->agentnum,": ", $agent->agent;
+ }
+ print "</SELECT>";
+}
+
+#referral
+
+my $refnum = $cust_main->refnum || $conf->config('referraldefault') || 0;
+if ( $custnum && ! $conf->exists('editreferrals') ) {
+ print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
+} else {
+ my(@referrals) = qsearch('part_referral',{});
+ if ( scalar(@referrals) == 0 ) {
+ die "You have not created any advertising sources. You must create at least one advertising source before adding a customer. Go to ". popurl(2). "browse/part_referral.cgi and create one or more advertising sources.";
+ } elsif ( scalar(@referrals) == 1 ) {
+ $refnum ||= $referrals[0]->refnum;
+ print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
+ } else {
+ print qq!<BR><BR>${r}Advertising source <SELECT NAME="refnum" SIZE="1">!;
+ print "<OPTION> " unless $refnum;
+ my($referral);
+ foreach $referral (sort {
+ $a->refnum <=> $b->refnum;
+ } @referrals) {
+ print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
+ ">", $referral->refnum, ": ", $referral->referral;
+ }
+ print "</SELECT>";
+ }
+}
+
+#referring customer
+
+#print qq!<BR><BR>Referring Customer: !;
+if ( $cust_main->referral_custnum ) {
+ my $referring_cust_main =
+ qsearchs('cust_main', { custnum => $cust_main->referral_custnum } );
+ print '<BR><BR>Referring Customer: <A HREF="'. popurl(1). '/cust_main.cgi?'.
+ $cust_main->referral_custnum. '">'.
+ $cust_main->referral_custnum. ': '.
+ ( $referring_cust_main->company
+ || $referring_cust_main->last. ', '. $referring_cust_main->first ).
+ '</A><INPUT TYPE="hidden" NAME="referral_custnum" VALUE="'.
+ $cust_main->referral_custnum. '">';
+} elsif ( ! $conf->exists('disable_customer_referrals') ) {
+ print '<BR><BR>Referring customer number: <INPUT TYPE="text" NAME="referral_custnum" VALUE="">';
+} else {
+ print '<INPUT TYPE="hidden" NAME="referral_custnum" VALUE="">';
+}
+
+# contact info
+
+my($last,$first,$ss,$company,$address1,$address2,$city,$zip)=(
+ $cust_main->last,
+ $cust_main->first,
+ $cust_main->ss,
+ $cust_main->company,
+ $cust_main->address1,
+ $cust_main->address2,
+ $cust_main->city,
+ $cust_main->zip,
+);
+
+print "<BR><BR>Billing address", &itable("#cccccc"), <<END;
+<TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3>
+END
+
+print <<END;
+<INPUT TYPE="text" NAME="last" VALUE="$last"> ,
+<INPUT TYPE="text" NAME="first" VALUE="$first">
+</TD>
+END
+
+if ( $conf->exists('show_ss') ) {
+ print qq!<TD ALIGN="right">SS#</TD><TD><INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11></TD>!;
+} else {
+ print qq!<TD><INPUT TYPE="hidden" NAME="ss" VALUE="$ss"></TD>!;
+}
+
+print <<END;
+</TR>
+<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="company" VALUE="$company" SIZE=70></TD></TR>
+<TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=70></TD></TR>
+<TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=70></TD></TR>
+<TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="city" VALUE="$city"></TD><TH ALIGN="right">${r}State</TH><TD>
+END
+
+#false laziness with ship state
+my $countrydefault = $conf->config('countrydefault') || 'US';
+$cust_main->country( $countrydefault ) unless $cust_main->country;
+
+$cust_main->state( $conf->config('statedefault') || 'CA' )
+ unless $cust_main->state || $cust_main->country ne 'US';
+
+my($county_html, $state_html, $country_html) =
+ FS::cust_main_county::regionselector( $cust_main->county,
+ $cust_main->state,
+ $cust_main->country );
+
+print "$county_html $state_html";
+
+print qq!</TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!;
+
+my($daytime,$night,$fax)=(
+ $cust_main->daytime,
+ $cust_main->night,
+ $cust_main->fax,
+);
+
+print <<END;
+<TR><TH ALIGN="right">${r}Country</TH><TD>$country_html</TD></TR>
+<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18></TD></TR>
+<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18></TD></TR>
+<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12></TD></TR>
+END
+
+print "</TABLE>${r}required fields<BR>";
+
+# service address
+
+if ( defined $cust_main->dbdef_table->column('ship_last') ) {
+
+ print "\n", <<END;
+ <SCRIPT>
+ function changed(what) {
+ what.form.same.checked = false;
+ }
+ function samechanged(what) {
+ if ( what.checked ) {
+END
+print " what.form.ship_$_.value = what.form.$_.value;\n"
+ for (qw( last first company address1 address2 city zip daytime night fax ));
+print <<END;
+ what.form.ship_country.selectedIndex = what.form.country.selectedIndex;
+ ship_country_changed(what.form.ship_country);
+ what.form.ship_state.selectedIndex = what.form.state.selectedIndex;
+ ship_state_changed(what.form.ship_state);
+ what.form.ship_county.selectedIndex = what.form.county.selectedIndex;
+ }
+ }
+ </SCRIPT>
+END
+
+ print '<BR>Service address ',
+ '(<INPUT TYPE="checkbox" NAME="same" VALUE="Y" onClick="samechanged(this)"';
+ unless ( $cust_main->ship_last ) {
+ print ' CHECKED';
+ foreach (
+ qw( last first company address1 address2 city county state zip country
+ daytime night fax )
+ ) {
+ $cust_main->set("ship_$_", $cust_main->get($_) );
+ }
+ }
+ print '>same as billing address)<BR>';
+
+ my($ship_last,$ship_first,$ship_company,$ship_address1,$ship_address2,$ship_city,$ship_zip)=(
+ $cust_main->ship_last,
+ $cust_main->ship_first,
+ $cust_main->ship_company,
+ $cust_main->ship_address1,
+ $cust_main->ship_address2,
+ $cust_main->ship_city,
+ $cust_main->ship_zip,
+ );
+
+ print &itable("#cccccc"), <<END;
+ <TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=5>
+END
+
+ print <<END;
+ <INPUT TYPE="text" NAME="ship_last" VALUE="$ship_last" onChange="changed(this)"> ,
+ <INPUT TYPE="text" NAME="ship_first" VALUE="$ship_first" onChange="changed(this)">
+END
+
+ print <<END;
+ </TD></TR>
+ <TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_company" VALUE="$ship_company" SIZE=70 onChange="changed(this)"></TD></TR>
+ <TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_address1" VALUE="$ship_address1" SIZE=70 onChange="changed(this)"></TD></TR>
+ <TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_address2" VALUE="$ship_address2" SIZE=70 onChange="changed(this)"></TD></TR>
+ <TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="ship_city" VALUE="$ship_city" onChange="changed(this)"></TD><TH ALIGN="right">${r}State</TH><TD>
+END
+
+ #false laziness with regular state
+ $cust_main->ship_country( $countrydefault ) unless $cust_main->ship_country;
+
+ $cust_main->ship_state( $conf->config('statedefault') || 'CA' )
+ unless $cust_main->ship_state || $cust_main->ship_country ne 'US';
+
+ my($ship_county_html, $ship_state_html, $ship_country_html) =
+ FS::cust_main_county::regionselector( $cust_main->ship_county,
+ $cust_main->ship_state,
+ $cust_main->ship_country,
+ 'ship_',
+ 'changed(this)', );
+
+ print "$ship_county_html $ship_state_html";
+
+ print qq!</TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="ship_zip" VALUE="$ship_zip" SIZE=10 onChange="changed(this)"></TD></TR>!;
+
+ my($ship_daytime,$ship_night,$ship_fax)=(
+ $cust_main->ship_daytime,
+ $cust_main->ship_night,
+ $cust_main->ship_fax,
+ );
+
+ print <<END;
+ <TR><TH ALIGN="right">${r}Country</TH><TD>$ship_country_html</TD></TR>
+ <TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_daytime" VALUE="$ship_daytime" SIZE=18 onChange="changed(this)"></TD></TR>
+ <TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_night" VALUE="$ship_night" SIZE=18 onChange="changed(this)"></TD></TR>
+ <TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="ship_fax" VALUE="$ship_fax" SIZE=12 onChange="changed(this)"></TD></TR>
+END
+
+ print "</TABLE>${r}required fields<BR>";
+
+}
+
+# billing info
+
+sub expselect {
+ my $prefix = shift;
+ my( $m, $y ) = (0, 0);
+ if ( scalar(@_) ) {
+ my $date = shift || '01-2000';
+ if ( $date =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
+ ( $m, $y ) = ( $2, $1 );
+ } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
+ ( $m, $y ) = ( $1, $3 );
+ } else {
+ die "unrecognized expiration date format: $date";
+ }
+ }
+
+ my $return = qq!<SELECT NAME="$prefix!. qq!_month" SIZE="1">!;
+ for ( 1 .. 12 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $m;
+ $return .= ">$_";
+ }
+ $return .= qq!</SELECT>/<SELECT NAME="$prefix!. qq!_year" SIZE="1">!;
+ for ( 2001 .. 2037 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $y;
+ $return .= ">$_";
+ }
+ $return .= "</SELECT>";
+
+ $return;
+}
+
+print "<BR>Billing information", &itable("#cccccc"),
+ qq!<TR><TD><INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!;
+print qq! CHECKED! if $cust_main->tax eq "Y";
+print qq!>Tax Exempt</TD></TR>!;
+print qq!<TR><TD><INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"!;
+my @invoicing_list = $cust_main->invoicing_list;
+print qq! CHECKED!
+ if ( ! @invoicing_list && ! $conf->exists('disablepostalinvoicedefault') )
+ || grep { $_ eq 'POST' } @invoicing_list;
+print qq!>Postal mail invoice</TD></TR>!;
+my $invoicing_list = join(', ', grep { $_ ne 'POST' } @invoicing_list );
+print qq!<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="$invoicing_list"></TD></TR>!;
+
+print "<TR><TD>Billing type</TD></TR>",
+ "</TABLE>",
+ &table("#cccccc"), "<TR>";
+
+my($payinfo, $payname)=(
+ $cust_main->payinfo,
+ $cust_main->payname,
+);
+
+my %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>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"),
+);
+my %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>Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate),
+);
+for (qw(CARD BILL COMP)) {
+ print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
+ if ($cust_main->payby eq "$_") {
+ print qq! CHECKED> $paybychecked{$_}</TD>!;
+ } else {
+ print qq!> $payby{$_}</TD>!;
+ }
+}
+
+print "</TR></TABLE>$r required fields for each billing type";
+
+if ( defined $cust_main->dbdef_table->column('comments') ) {
+ print "<BR><BR>Comments", &itable("#cccccc"),
+ qq!<TR><TD><TEXTAREA COLS=80 ROWS=5 WRAP="HARD" NAME="comments">!,
+ $cust_main->comments, "</TEXTAREA>",
+ "</TD></TR></TABLE>";
+}
+
+unless ( $custnum ) {
+ # pry the wrong place for this logic. also pretty expensive
+ #use FS::part_pkg;
+
+ #false laziness, copied from FS::cust_pkg::order
+ my $pkgpart;
+ if ( scalar(@agents) == 1 ) {
+ # $pkgpart->{PKGPART} is true iff $custnum may purchase PKGPART
+ my($agent)=qsearchs('agent',{'agentnum'=> $agentnum });
+ $pkgpart = $agent->pkgpart_hashref;
+ } else {
+ #can't know (agent not chosen), so, allow all
+ my %typenum;
+ foreach my $agent ( @agents ) {
+ next if $typenum{$agent->typenum}++;
+ #fixed in 5.004_05 #$pkgpart->{$_}++ foreach keys %{ $agent->pkgpart_hashref }
+ foreach ( keys %{ $agent->pkgpart_hashref } ) { $pkgpart->{$_}++; } #5.004_04 workaround
+ }
+ }
+ #eslaf
+
+ my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } }
+ qsearch( 'part_pkg', { 'disabled' => '' } );
+
+ if ( @part_pkg ) {
+
+# print "<BR><BR>First package", &itable("#cccccc", "0 ALIGN=LEFT"),
+#apiabuse & undesirable wrapping
+ print "<BR><BR>First package", &itable("#cccccc"),
+ qq!<TR><TD COLSPAN=2><SELECT NAME="pkgpart_svcpart">!;
+
+ print qq!<OPTION VALUE="">(none)!;
+
+ foreach my $part_pkg ( @part_pkg ) {
+ print qq!<OPTION VALUE="!,
+# $part_pkg->pkgpart. "_". $pkgpart{ $part_pkg->pkgpart }, '"';
+ $part_pkg->pkgpart. "_". $part_pkg->svcpart, '"';
+ print " SELECTED" if $saved_pkgpart && ( $part_pkg->pkgpart == $saved_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;
+ my $ulen = dbdef->table('svc_acct')->column('username')->length;
+ my $ulen2 = $ulen+2;
+ my $passwordmax = $conf->config('passwordmax') || 8;
+ my $pmax2 = $passwordmax + 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=$pmax2 MAXLENGTH=$passwordmax>
+(blank to generate)</TD></TR>
+END
+
+ print '<TR><TD ALIGN="right">Access number</TD><TD WIDTH="100%">'
+ .
+ &FS::svc_acct_pop::popselector($popnum).
+ '</TD></TR></TABLE>'
+ ;
+ }
+}
+
+my $otaker = $cust_main->otaker;
+print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!,
+ qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $custnum ? "Apply Changes" : "Add Customer", qq!">!,
+ "</FORM></BODY></HTML>",
+;
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($taxnum, $delim, $expansion, $taxclass );
+my($query) = $cgi->keywords;
+if ( $cgi->param('error') ) {
+ $taxnum = $cgi->param('taxnum');
+ $delim = $cgi->param('delim');
+ $expansion = $cgi->param('expansion');
+ $taxclass = $cgi->param('taxclass');
+} else {
+ $query =~ /^(taxclass)?(\d+)$/
+ or die "Illegal taxnum (query $query)";
+ $taxclass = $1 ? 'taxclass' : '';
+ $taxnum = $2;
+ $delim = 'n';
+ $expansion = '';
+}
+
+my $cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
+ or die "cust_main_county.taxnum $taxnum not found";
+die "Can't expand entry!" if $cust_main_county->getfield('county');
+
+my $p1 = popurl(1);
+print 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">
+ <INPUT TYPE="hidden" NAME="taxclass" VALUE="$taxclass">
+ Separate by
+END
+print '<INPUT TYPE="radio" NAME="delim" VALUE="n"';
+print ' CHECKED' if $delim eq 'n';
+print '>line (broken on some browsers) or',
+ '<INPUT TYPE="radio" NAME="delim" VALUE="s"';
+print ' CHECKED' if $delim eq 's';
+print '>whitespace.';
+print <<END;
+ <BR><INPUT TYPE="submit" VALUE="Submit">
+ <BR><TEXTAREA NAME="expansion" ROWS=100>$expansion</TEXTAREA>
+ </FORM>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header("Edit tax rates", menubar(
+ 'Main Menu' => popurl(2),
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="!, popurl(1),
+ qq!process/cust_main_county.cgi" METHOD=POST>!, &table(), <<END;
+ <TR>
+ <TH><FONT SIZE=-1>Country</FONT></TH>
+ <TH><FONT SIZE=-1>State</FONT></TH>
+ <TH><FONT SIZE=-1>County</FONT></TH>
+ <TH><FONT SIZE=-1>Taxclass</FONT></TH>
+ <TH><FONT SIZE=-1>Tax</FONT></TH>
+ <TH><FONT SIZE=-1>Exempt<BR>per<BR>month</TH>
+ </TR>
+END
+
+foreach my $cust_main_county ( sort { $a->country cmp $b->country
+ or $a->state cmp $b->state
+ or $a->county cmp $b->county
+ } qsearch('cust_main_county',{}) ) {
+ my($hashref)=$cust_main_county->hashref;
+ print <<END;
+ <TR>
+ <TD BGCOLOR="#ffffff">$hashref->{country}</TD>
+END
+
+ print "<TD", $hashref->{state}
+ ? ' BGCOLOR="#ffffff">'.$hashref->{state}
+ : ' BGCOLOR="#cccccc">(ALL)'
+ , "</TD>";
+
+ print "<TD", $hashref->{county}
+ ? ' BGCOLOR="#ffffff">'. $hashref->{county}
+ : ' BGCOLOR="#cccccc">(ALL)'
+ , "</TD>";
+
+ print "<TD", $hashref->{taxclass}
+ ? ' BGCOLOR="#ffffff">'. $hashref->{taxclass}
+ : ' BGCOLOR="#cccccc">(ALL)'
+ , "</TD>";
+
+ print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
+ qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD>!;
+ print qq!<TD>\$<INPUT TYPE="text" NAME="exempt_amount!, $hashref->{taxnum},
+ qq!" VALUE="!, $hashref->{exempt_amount}||0, qq!" SIZE=6></TD>!;
+ print '</TR>';
+
+}
+
+print <<END;
+ </TABLE>
+ <INPUT TYPE="submit" VALUE="Apply changes">
+ </FORM>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+
+my($link, $linknum, $paid, $payby, $payinfo, $quickpay);
+if ( $cgi->param('error') ) {
+ $link = $cgi->param('link');
+ $linknum = $cgi->param('linknum');
+ $paid = $cgi->param('paid');
+ $payby = $cgi->param('payby');
+ $payinfo = $cgi->param('payinfo');
+ $quickpay = $cgi->param('quickpay');
+} elsif ($cgi->keywords) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $link = 'invnum';
+ $linknum = $1;
+ $paid = '';
+ $payby = 'BILL';
+ $payinfo = "";
+ $quickpay = '';
+} elsif ( $cgi->param('custnum') =~ /^(\d+)$/ ) {
+ $link = 'custnum';
+ $linknum = $1;
+ $paid = '';
+ $payby = 'BILL';
+ $payinfo = '';
+ $quickpay = $cgi->param('quickpay');
+} else {
+ die "illegal query ". $cgi->keywords;
+}
+my $_date = time;
+
+my $paybatch = "webui-$_date-$$-". rand() * 2**32;
+
+my $p1 = popurl(1);
+print header("Post payment", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT><BR><BR>"
+ if $cgi->param('error');
+
+print <<END, ntable("#cccccc",2);
+ <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST>
+ <INPUT TYPE="hidden" NAME="link" VALUE="$link">
+ <INPUT TYPE="hidden" NAME="linknum" VALUE="$linknum">
+ <INPUT TYPE="hidden" NAME="quickpay" VALUE="$quickpay">
+END
+
+my $custnum;
+if ( $link eq 'invnum' ) {
+
+ my $cust_bill = qsearchs('cust_bill', { 'invnum' => $linknum } )
+ or die "unknown invnum $linknum";
+ print "Invoice #<B>$linknum</B>". ntable("#cccccc",2).
+ '<TR><TD ALIGN="right">Date</TD><TD BGCOLOR="#ffffff">'.
+ time2str("%D", $cust_bill->_date). '</TD></TR>'.
+ '<TR><TD ALIGN="right" VALIGN="top">Items</TD><TD BGCOLOR="#ffffff">';
+ foreach ( $cust_bill->cust_bill_pkg ) { #false laziness with FS::cust_bill
+ if ( $_->pkgnum ) {
+
+ my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
+ my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
+ my($pkg)=$part_pkg->pkg;
+
+ if ( $_->setup != 0 ) {
+ print "$pkg Setup<BR>"; # $money_char. sprintf("%10.2f",$_->setup);
+ print join('<BR>',
+ map { " ". $_->[0]. ": ". $_->[1] } $cust_pkg->labels
+ ). '<BR>';
+ }
+
+ if ( $_->recur != 0 ) {
+ print
+ "$pkg (" . time2str("%x",$_->sdate) . " - " .
+ time2str("%x",$_->edate) . ")<BR>";
+ #$money_char. sprintf("%10.2f",$_->recur)
+ print join('<BR>',
+ map { '--->'. $_->[0]. ": ". $_->[1] } $cust_pkg->labels
+ ). '<BR>';
+ }
+
+ } else { #pkgnum Tax
+ print "Tax<BR>" # $money_char. sprintf("%10.2f",$_->setup)
+ if $_->setup != 0;
+ }
+
+ }
+ print '</TD></TR></TABLE><BR><BR>';
+
+ $custnum = $cust_bill->custnum;
+
+} elsif ( $link eq 'custnum' ) {
+ $custnum = $linknum;
+}
+
+print small_custview($custnum, $conf->config('countrydefault'));
+
+print qq!<INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!;
+print qq!<INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!;
+
+print '<BR><BR>Payment'. ntable("#cccccc", 2).
+ '<TR><TD ALIGN="right">Date</TD><TD BGCOLOR="#ffffff">'.
+ time2str("%D",$_date). '</TD></TR>';
+
+print qq!<TR><TD ALIGN="right">Amount</TD><TD BGCOLOR="#ffffff">\$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8></TD></TR>!;
+
+print qq!<TR><TD ALIGN="right">Payby</TD><TD BGCOLOR="#ffffff">$payby</TD></TR>!;
+
+#payinfo (check # now as payby="BILL" hardcoded.. what to do later?)
+print qq!<TR><TD ALIGN="right">Check #</TD><TD BGCOLOR="#ffffff"><INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo"></TD></TR>!;
+
+print qq!<TR><TD ALIGN="right">Auto-apply<BR>to invoices</TD><TD><SELECT NAME="apply"><OPTION VALUE="yes" SELECTED>yes<OPTION>no</SELECT></TD>!;
+
+print "</TABLE>";
+
+#paybatch
+print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="$paybatch">!;
+
+print <<END;
+<BR>
+<INPUT TYPE="submit" VALUE="Post payment">
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my %pkg = ();
+my %comment = ();
+my %all_pkg = ();
+my %all_comment = ();
+#foreach (qsearch('part_pkg', { 'disabled' => '' })) {
+# $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
+# $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
+#}
+foreach (qsearch('part_pkg', {} )) {
+ $all_pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
+ $all_comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
+ next if $_->disabled;
+ $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
+ $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
+}
+
+my($custnum, %remove_pkg);
+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;
+ %remove_pkg = ();
+}
+
+my $p1 = popurl(1);
+print header("Add/Edit Packages", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!;
+
+print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
+
+#current packages
+my @cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } );
+
+if (@cust_pkg) {
+ print <<END;
+Current packages - select to remove (services are moved to a new package below)
+<BR><BR>
+END
+
+ my $count = 0 ;
+ print qq!<TABLE>! ;
+ foreach (@cust_pkg) {
+ print '<TR>' if $count == 0;
+ my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
+ print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!;
+ print " CHECKED" if $remove_pkg{$pkgnum};
+ print qq!>$pkgnum: $all_pkg{$pkgpart} - $all_comment{$pkgpart}</TD>\n!;
+ $count ++ ;
+ if ($count == 2)
+ {
+ $count = 0 ;
+ print qq!</TR>\n! ;
+ }
+ }
+ print qq!</TABLE><BR><BR>!;
+}
+
+print <<END;
+Order new packages<BR><BR>
+END
+
+my $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+my $agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
+
+my $count = 0;
+my $pkgparts = 0;
+print qq!<TABLE>!;
+foreach my $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ $pkgparts++;
+ my($pkgpart)=$type_pkgs->pkgpart;
+ next unless exists $pkg{$pkgpart}; #skip disabled ones
+ print qq!<TR>! if ( $count == 0 );
+ my $value = $cgi->param("pkg$pkgpart") || 0;
+ print <<END;
+ <TD>
+ <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2">
+ $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
+END
+ $count ++ ;
+ if ( $count == 2 ) {
+ print qq!</TR>\n! ;
+ $count = 0;
+ }
+}
+print qq!</TABLE>!;
+
+unless ( $pkgparts ) {
+ my $p2 = popurl(2);
+ my $typenum = $agent->typenum;
+ my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
+ my $atype = $agent_type->atype;
+ print <<END;
+(No <a href="${p2}browse/part_pkg.cgi">package definitions</a>, or agent type
+<a href="${p2}edit/agent_type.cgi?$typenum">$atype</a> not allowed to purchase
+any packages.)
+END
+}
+
+#submit
+print <<END;
+<P><INPUT TYPE="submit" VALUE="Order">
+ </FORM>
+ </BODY>
+</HTML>
+END
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+print header("Edit Message catalog", menubar(
+# 'Main Menu' => $p,
+)), '<BR>';
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !. $cgi->param('error').
+ '</FONT><BR><BR>'
+ if $cgi->param('error');
+
+my $widget = new HTML::Widgets::SelectLayers(
+ 'selected_layer' => 'en_US',
+ 'options' => { 'en_US'=>'en_US' },
+ 'form_action' => 'process/msgcat.cgi',
+ 'layer_callback' => sub {
+ my $layer = shift;
+ my $html = qq!<INPUT TYPE="hidden" NAME="locale" VALUE="$layer">!.
+ "<BR>Messages for locale $layer<BR>". table().
+ "<TR><TH COLSPAN=2>Code</TH>".
+ "<TH>Message</TH>";
+ $html .= "<TH>en_US Message</TH>" unless $layer eq 'en_US';
+ $html .= '</TR>';
+
+ #foreach my $msgcat ( sort { $a->msgcode cmp $b->msgcode }
+ # qsearch('msgcat', { 'locale' => $layer } ) ) {
+ foreach my $msgcat ( qsearch('msgcat', { 'locale' => $layer } ) ) {
+ $html .=
+ '<TR><TD>'. $msgcat->msgnum. '</TD><TD>'. $msgcat->msgcode. '</TD>'.
+ '<TD><INPUT TYPE="text" SIZE=32 '.
+ qq! NAME="!. $msgcat->msgnum. '" '.
+ qq!VALUE="!. ($cgi->param($msgcat->msgnum)||$msgcat->msg). qq!"></TD>!;
+ unless ( $layer eq 'en_US' ) {
+ my $en_msgcat = qsearchs('msgcat', {
+ 'locale' => 'en_US',
+ 'msgcode' => $msgcat->msgcode,
+ } );
+ $html .= '<TD>'. $en_msgcat->msg. '</TD>';
+ }
+ $html .= '</TR>';
+ }
+
+ $html .= '</TABLE><BR><INPUT TYPE="submit" VALUE="Apply changes">';
+
+ $html;
+ },
+
+);
+
+print $widget->html;
+
+print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+if ( $cgi->param('eventpart') && $cgi->param('eventpart') =~ /^(\d+)$/ ) {
+ $cgi->param('eventpart', $1);
+} else {
+ $cgi->param('eventpart', '');
+}
+
+my ($query) = $cgi->keywords;
+my $action = '';
+my $part_bill_event = '';
+if ( $cgi->param('error') ) {
+ $part_bill_event = new FS::part_bill_event ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_bill_event')
+ } );
+}
+if ( $query && $query =~ /^(\d+)$/ ) {
+ $part_bill_event ||= qsearchs('part_bill_event',{'eventpart'=>$1});
+} else {
+ $part_bill_event ||= new FS::part_bill_event {};
+}
+$action ||= $part_bill_event->pkgpart ? 'Edit' : 'Add';
+my $hashref = $part_bill_event->hashref;
+
+print header("$action Invoice Event Definition", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all invoice events' => popurl(2). 'browse/part_bill_event.cgi',
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/part_bill_event.cgi" METHOD=POST>'.
+ '<INPUT TYPE="hidden" NAME="eventpart" VALUE="'.
+ $part_bill_event->eventpart .'">';
+print "Invoice Event #", $hashref->{eventpart} ? $hashref->{eventpart} : "(NEW)";
+
+print ntable("#cccccc",2), <<END;
+<TR><TD ALIGN="right">Payby</TD><TD><SELECT NAME="payby">
+END
+
+for (qw(CARD BILL COMP)) {
+ print qq!<OPTION VALUE="$_"!;
+ if ($part_bill_event->payby eq $_) {
+ print " SELECTED>$_</OPTION>";
+ } else {
+ print ">$_</OPTION>";
+ }
+}
+
+my $days = $hashref->{seconds}/86400;
+
+print <<END;
+</SELECT></TD></TR>
+<TR><TD ALIGN="right">Event</TD><TD><INPUT TYPE="text" NAME="event" VALUE="$hashref->{event}"></TD></TR>
+<TR><TD ALIGN="right">After</TD><TD><INPUT TYPE="text" NAME="days" VALUE="$days"> days</TD></TR>
+END
+
+print '<TR><TD ALIGN="right">Disabled</TD><TD>';
+print '<INPUT TYPE="checkbox" NAME="disabled" VALUE="Y"';
+print ' CHECKED' if $hashref->{disabled} eq "Y";
+print '>';
+print '</TD></TR>';
+
+print '<TR><TD ALIGN="right">Action</TD><TD>';
+
+#print ntable();
+
+#this is pretty kludgy right here.
+tie my %events, 'Tie::IxHash',
+
+ 'fee' => {
+ 'name' => 'Late fee',
+ 'code' => '$cust_main->charge( %%%charge%%%, \'%%%reason%%%\' );',
+ 'html' =>
+ 'Amount <INPUT TYPE="text" SIZE="7" NAME="charge" VALUE="%%%charge%%%">'.
+ '<BR>Reason <INPUT TYPE="text" NAME="reason" VALUE="%%%reason%%%">',
+ 'weight' => 10,
+ },
+ 'suspend' => {
+ 'name' => 'Suspend',
+ 'code' => '$cust_main->suspend();',
+ 'weight' => 10,
+ },
+ 'cancel' => {
+ 'name' => 'Cancel',
+ 'code' => '$cust_main->cancel();',
+ 'weight' => 10,
+ },
+
+ 'addpost' => {
+ 'name' => 'Add postal invoicing',
+ 'code' => '$cust_main->invoicing_list_addpost(); "";',
+ 'weight' => 20,
+ },
+
+ 'comp' => {
+ 'name' => 'Pay invoice with a complimentary "payment"',
+ 'code' => '$cust_bill->comp();',
+ 'weight' => 30,
+ },
+
+ 'realtime-card' => {
+ 'name' => 'Run card with a <a href="http://search.cpan.org/search?mode=module&query=Business%3A%3AOnlinePayment">Business::OnlinePayment</a> realtime gateway',
+ 'code' => '$cust_bill->realtime_card();',
+ 'weight' => 30,
+ },
+
+ 'realtime-card-cybercash' => {
+ 'name' => '(<b>deprecated</b>) Run card with <a href="http://www.cybercash.com/cashregister">CyberCash CashRegister</a> realtime gateway',
+ 'code' => '$cust_bill->realtime_card_cybercash();',
+ 'weight' => 30,
+ },
+
+ 'batch-card' => {
+ 'name' => 'Add card to the pending credit card batch',
+ 'code' => '$cust_bill->batch_card();',
+ 'weight' => 40,
+ },
+
+ 'send' => {
+ 'name' => 'Send invoice (email/print)',
+ 'code' => '$cust_bill->send();',
+ 'weight' => 50,
+ },
+
+ 'send_alternate' => {
+ 'name' => 'Send invoice (email/print) with alternate template',
+ 'code' => '$cust_bill->send(\'%%%templatename%%%\');',
+ 'html' =>
+ '<INPUT TYPE="text" NAME="templatename" VALUE="%%%templatename%%%">',
+ 'weight' => 50,
+ },
+
+ 'bill' => {
+ 'name' => 'Generate invoices (normally only used with a <i>Late Fee</i> event)',
+ 'code' => '$cust_main->bill();',
+ 'weight' => 60,
+ },
+
+ 'apply' => {
+ 'name' => 'Apply unapplied payments and credits',
+ 'code' => '$cust_main->apply_payments; $cust_main->apply_credits; "";',
+ 'weight' => 70,
+ },
+
+ 'collect' => {
+ 'name' => 'Collect on invoices (normally only used with a <i>Late Fee</i> and <i>Generate Invoice</i> events)',
+ 'code' => '$cust_main->collect();',
+ 'weight' => 80,
+ },
+
+;
+
+foreach my $event ( keys %events ) {
+ my %plandata = map { /^(\w+) (.*)$/; ($1, $2); }
+ split(/\n/, $part_bill_event->plandata);
+ my $html = $events{$event}{html};
+ while ( $html =~ /%%%(\w+)%%%/ ) {
+ my $field = $1;
+ $html =~ s/%%%$field%%%/$plandata{$field}/;
+ }
+
+ print ntable( "#cccccc", 2).
+ qq!<TR><TD><INPUT TYPE="radio" NAME="plan_weight_eventcode" !;
+ print "CHECKED " if $event eq $part_bill_event->plan;
+ print qq!VALUE="!. $event. ":". $events{$event}{weight}. ":".
+ encode_entities($events{$event}{code}).
+ qq!">$events{$event}{name}</TD>!;
+ print '<TD>'. $html. '</TD>' if $html;
+ print qq!</TR>!;
+ print '</TABLE>';
+}
+
+#print '</TABLE>';
+
+print <<END;
+</TD></TR>
+</TABLE>
+END
+
+print qq!<INPUT TYPE="submit" VALUE="!,
+ $hashref->{eventpart} ? "Apply changes" : "Add invoice event",
+ qq!">!;
+%>
+
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+#if ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {
+# $cgi->param('clone', $1);
+#} else {
+# $cgi->param('clone', '');
+#}
+
+my($query) = $cgi->keywords;
+my $action = '';
+my $part_export = '';
+if ( $cgi->param('error') ) {
+ $part_export = new FS::part_export ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_export')
+ } );
+} elsif ( $query =~ /^(\d+)$/ ) {
+ $part_export = qsearchs('part_export', { 'exportnum' => $1 } );
+} else {
+ $part_export = new FS::part_export;
+}
+$action ||= $part_export->exportnum ? 'Edit' : 'Add';
+
+#my $exports = FS::part_export::export_info($svcdb);
+my $exports = FS::part_export::export_info();
+
+my %layers = map { $_ => "$_ - ". $exports->{$_}{desc} } keys %$exports;
+$layers{''}='';
+
+my $widget = new HTML::Widgets::SelectLayers(
+ 'selected_layer' => $part_export->exporttype,
+ 'options' => \%layers,
+ 'form_name' => 'dummy',
+ 'form_action' => 'process/part_export.cgi',
+ 'form_text' => [qw( exportnum machine )],
+# 'form_checkbox' => [qw()],
+ 'html_between' => "</TD></TR></TABLE>\n",
+ 'layer_callback' => sub {
+ my $layer = shift;
+ my $html = qq!<INPUT TYPE="hidden" NAME="exporttype" VALUE="$layer">!.
+ ntable("#cccccc",2);
+
+ $html .= '<TR><TD ALIGN="right">Description</TD><TD BGCOLOR=#ffffff>'.
+ $exports->{$layer}{notes}. '</TD></TR>'
+ if $layer;
+
+ foreach my $option ( keys %{$exports->{$layer}{options}} ) {
+# foreach my $option ( qw(url login password groupID ) ) {
+ my $optinfo = $exports->{$layer}{options}{$option};
+ my $label = $optinfo->{label};
+ my $value = $cgi->param($option)
+ || $part_export->option($option)
+ || (exists $optinfo->{default} ? $optinfo->{default} : '');
+ $html .= qq!<TR><TD ALIGN="right">$label</TD>!.
+ qq!<TD><INPUT TYPE="text" NAME="$option" VALUE="$value" SIZE=64></TD>!.
+ '</TR>';
+ }
+ $html .= '</TABLE>';
+
+ $html .= '<INPUT TYPE="hidden" NAME="options" VALUE="'.
+ join(',', keys %{$exports->{$layer}{options}} ). '">';
+
+ $html .= '<INPUT TYPE="hidden" NAME="nodomain" VALUE="'.
+ $exports->{$layer}{nodomain}. '">';
+
+ $html .= '<INPUT TYPE="submit" VALUE="'.
+ ( $part_export->exportnum ? "Apply changes" : "Add export" ).
+ '">';
+
+ $html;
+ },
+);
+
+%>
+<%= header("$action Export", menubar(
+ 'Main Menu' => popurl(2),
+), ' onLoad="visualize()"')
+%>
+
+<% if ( $cgi->param('error') ) { %>
+ <FONT SIZE="+1" COLOR="#ff0000">Error: <%= $cgi->param('error') %></FONT>
+ <BR><BR>
+<% } %>
+
+<FORM NAME="dummy">
+<INPUT TYPE="hidden" NAME="exportnum" VALUE="<%= $part_export->exportnum %>">
+
+<%= ntable("#cccccc",2) %>
+<TR>
+ <TD ALIGN="right">Export host</TD>
+ <TD>
+ <INPUT TYPE="text" NAME="machine" VALUE="<%= $part_export->machine %>">
+ </TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Export</TD>
+ <TD><%= $widget->html %>
+</BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+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 ($query) = $cgi->keywords;
+my $action = '';
+my $part_pkg = '';
+if ( $cgi->param('error') ) {
+ $part_pkg = new FS::part_pkg ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_pkg')
+ } );
+}
+if ( $cgi->param('clone') ) {
+ $action='Custom Pricing';
+ my $old_part_pkg =
+ qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } );
+ $part_pkg ||= $old_part_pkg->clone;
+ $part_pkg->disabled('Y');
+} elsif ( $query && $query =~ /^(\d+)$/ ) {
+ $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1});
+} else {
+ unless ( $part_pkg ) {
+ $part_pkg = new FS::part_pkg {};
+ $part_pkg->plan('flat');
+ }
+}
+unless ( $part_pkg->plan ) { #backwards-compat
+ $part_pkg->plan('flat');
+ $part_pkg->plandata("setup_fee=". $part_pkg->setup. "\n".
+ "recur_fee=". $part_pkg->recur. "\n");
+}
+$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add';
+my $hashref = $part_pkg->hashref;
+
+
+print header("$action Package Definition", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all packages' => popurl(2). 'browse/part_pkg.cgi',
+));
+#), ' onLoad="visualize()"');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+#print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>';
+print '<FORM NAME="dummy">';
+
+#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}">!,
+print "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
+
+print ntable("#cccccc",2), <<END;
+<TR><TD ALIGN="right">Package (customer-visable)</TD><TD><INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}"></TD></TR>
+<TR><TD ALIGN="right">Comment (customer-hidden)</TD><TD><INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}"></TD></TR>
+<TR><TD ALIGN="right">Frequency (months) of recurring fee</TD><TD><INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}" SIZE=3></TD></TR>
+<TR><TD ALIGN="right">Setup fee tax exempt</TD><TD>
+END
+
+print '<INPUT TYPE="checkbox" NAME="setuptax" VALUE="Y"';
+print ' CHECKED' if $hashref->{setuptax} eq "Y";
+print '>';
+
+print <<END;
+</TD></TR>
+<TR><TD ALIGN="right">Recurring fee tax exempt</TD><TD>
+END
+
+print '<INPUT TYPE="checkbox" NAME="recurtax" VALUE="Y"';
+print ' CHECKED' if $hashref->{recurtax} eq "Y";
+print '>';
+
+print '</TD></TR>';
+
+my $conf = new FS::Conf;
+if ( $conf->exists('enable_taxclasses') ) {
+ print '<TR><TD ALIGN="right">Tax class</TD><TD><SELECT NAME="taxclass">';
+ my $sth = dbh->prepare('SELECT DISTINCT taxclass FROM cust_main_county')
+ or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ foreach my $taxclass ( map $_->[0], @{$sth->fetchall_arrayref} ) {
+ print qq!<OPTION VALUE="$taxclass"!;
+ print ' SELECTED' if $taxclass eq $hashref->{taxclass};
+ print qq!>$taxclass</OPTION>!;
+ }
+ print '</SELECT></TD></TR>';
+} else {
+ print
+ '<INPUT TYPE="hidden" NAME="taxclass" VALUE="'. $hashref->{taxclass}. '">';
+}
+
+print '<TR><TD ALIGN="right">Disable new orders</TD><TD>';
+print '<INPUT TYPE="checkbox" NAME="disabled" VALUE="Y"';
+print ' CHECKED' if $hashref->{disabled} eq "Y";
+print '>';
+print '</TD></TR></TABLE>';
+
+my $thead = "\n\n". ntable('#cccccc', 2). <<END;
+<TR><TH BGCOLOR="#dcdcdc"><FONT SIZE=-1>Quan.</FONT></TH><TH BGCOLOR="#dcdcdc">Service</TH></TR>
+END
+
+#unless ( $cgi->param('clone') ) {
+#dunno why...
+unless ( 0 ) {
+ #print <<END, $thead;
+ print <<END, itable(), '<TR><TD VALIGN="top">', $thead;
+<BR><BR>Enter the quantity of each service this package includes.<BR><BR>
+END
+}
+
+my @fixups = ();
+my $count = 0;
+my $columns = 3;
+my @part_svc = qsearch( 'part_svc', { 'disabled' => '' } );
+foreach my $part_svc ( @part_svc ) {
+ my $svcpart = $part_svc->svcpart;
+ my $pkg_svc = qsearchs( 'pkg_svc', {
+ 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
+ 'svcpart' => $svcpart,
+ } ) || new FS::pkg_svc ( {
+ 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
+ 'svcpart' => $svcpart,
+ 'quantity' => 0,
+ });
+ #? #next unless $pkg_svc;
+
+ push @fixups, "pkg_svc$svcpart";
+
+ #unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) {
+ #dunno why...
+ unless ( 0 ) {
+ print '<TR>'; # if $count == 0 ;
+ print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=4 MAXLENGTH=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></TR>";
+# print "</TABLE></TD><TD>$thead" if ++$count == int(scalar(@part_svc) / 2);
+ $count+=1;
+ foreach ( 1 .. $columns-1 ) {
+ print "</TABLE></TD><TD VALIGN=\"top\">$thead"
+ if $count == int( $_ * scalar(@part_svc) / $columns );
+ }
+ } else {
+ print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!,
+ $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!;
+ }
+}
+
+#unless ( $cgi->param('clone') ) {
+#dunno why...
+unless ( 0 ) {
+ print "</TR></TABLE></TD></TR></TABLE>";
+ #print "</TR></TABLE>";
+}
+
+foreach my $f ( qw( clone pkgnum ) ) {
+ print qq!<INPUT TYPE="hidden" NAME="$f" VALUE="!. $cgi->param($f). '">';
+}
+print '<INPUT TYPE="hidden" NAME="pkgpart" VALUE="'. $part_pkg->pkgpart. '">';
+
+# prolly should be in database
+tie my %plans, 'Tie::IxHash',
+ 'flat' => {
+ 'name' => 'Flat rate (anniversary billing)',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_fee' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => 'what.recur_fee.value',
+ },
+
+ 'flat_delayed' => {
+ 'name' => 'Free for X days, then flat rate (anniversary billing)',
+ 'fields' => {
+ 'free_days' => { 'name' => 'Initial free days',
+ 'default' => 0,
+ },
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ },
+ 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee' ],
+ 'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value',
+ 'recur' => 'what.recur_fee.value',
+ },
+
+ 'prorate' => {
+ 'name' => 'First partial month pro-rated, then flat-rate (1st of month billing)',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_fee' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '\'my $mnow = $sdate; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; my $mstart = timelocal(0,0,0,1,$mon,$year); my $mend = timelocal(0,0,0,1, $mon == 11 ? 0 : $mon+1, $year+($mon==11)); $sdate = $mstart; ( $part_pkg->freq - 1 ) * \' + what.recur_fee.value + \' / $part_pkg->freq + \' + what.recur_fee.value + \' / $part_pkg->freq * ($mend-$mnow) / ($mend-$mstart) ; \'',
+ },
+
+ 'subscription' => {
+ 'name' => 'First partial month full charge, then flat-rate (1st of month billing)',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_fee' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '\'my $mnow = $sdate; my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; $sdate = timelocal(0,0,0,1,$mon,$year); \' + what.recur_fee.value',
+ },
+
+ 'flat_comission_cust' => {
+ 'name' => 'Flat rate with recurring comission per active customer',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ 'comission_amount' => { 'name' => 'Comission amount per month (per active customer)',
+ 'default' => 0,
+ },
+ 'comission_depth' => { 'name' => 'Number of layers',
+ 'default' => 1,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
+ },
+
+ 'flat_comission' => {
+ 'name' => 'Flat rate with recurring comission per (any) active package',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ 'comission_amount' => { 'name' => 'Comission amount per month (per active package)',
+ 'default' => 0,
+ },
+ 'comission_depth' => { 'name' => 'Number of layers',
+ 'default' => 1,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
+ },
+
+ 'flat_comission_pkg' => {
+ 'name' => 'Flat rate with recurring comission per (selected) active package',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_fee' => { 'name' => 'Recurring fee for this package',
+ 'default' => 0,
+ },
+ 'comission_amount' => { 'name' => 'Comission amount per month (per uncancelled package)',
+ 'default' => 0,
+ },
+ 'comission_depth' => { 'name' => 'Number of layers',
+ 'default' => 1,
+ },
+ 'comission_pkgpart' => { 'name' => 'Applicable packages<BR><FONT SIZE="-1">(hold <b>ctrl</b> to select multiple packages)</FONT>',
+ 'type' => 'select_multiple',
+ 'select_table' => 'part_pkg',
+ 'select_hash' => { 'disabled' => '' } ,
+ 'select_key' => 'pkgpart',
+ 'select_label' => 'pkg',
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount', 'comission_pkgpart' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \' ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'',
+ },
+
+
+
+ 'sesmon_hour' => {
+ 'name' => 'Base charge plus charge per-hour from the session monitor',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_flat' => { 'name' => 'Base monthly charge for this package',
+ 'default' => 0,
+ },
+ 'recur_included_hours' => { 'name' => 'Hours included',
+ 'default' => 0,
+ },
+ 'recur_hourly_charge' => { 'name' => 'Additional charge per hour',
+ 'default' => 0,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_flat', 'recur_included_hours', 'recur_hourly_charge' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '\'my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; \' + what.recur_flat.value + \' + \' + what.recur_hourly_charge.value + \' * $hours;\'',
+ },
+
+ 'sesmon_minute' => {
+ 'name' => 'Base charge plus charge per-minute from the session monitor',
+ 'fields' => {
+ 'setup_fee' => { 'name' => 'Setup fee for this package',
+ 'default' => 0,
+ },
+ 'recur_flat' => { 'name' => 'Base monthly charge for this package',
+ 'default' => 0,
+ },
+ 'recur_included_min' => { 'name' => 'Minutes included',
+ 'default' => 0,
+ },
+ 'recur_minly_charge' => { 'name' => 'Additional charge per minute',
+ 'default' => 0,
+ },
+ },
+ 'fieldorder' => [ 'setup_fee', 'recur_flat', 'recur_included_min', 'recur_minly_charge' ],
+ 'setup' => 'what.setup_fee.value',
+ 'recur' => '\'my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60 - \' + what.recur_included_min.value + \'; $min = 0 if $min < 0; \' + what.recur_flat.value + \' + \' + what.recur_minly_charge.value + \' * $min;\'',
+
+ },
+
+;
+
+my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
+ split("\n", $part_pkg->plandata );
+
+tie my %options, 'Tie::IxHash', map { $_=>$plans{$_}->{'name'} } keys %plans;
+
+my @form_select = ();
+if ( $conf->exists('enable_taxclasses') ) {
+ push @form_select, 'taxclass';
+} else {
+ push @fixups, 'taxclass'; #hidden
+}
+
+
+my $widget = new HTML::Widgets::SelectLayers(
+ 'selected_layer' => $part_pkg->plan,
+ 'options' => \%options,
+ 'form_name' => 'dummy',
+ 'form_action' => 'process/part_pkg.cgi',
+ 'form_text' => [ qw(pkg comment freq clone pkgnum pkgpart), @fixups ],
+ 'form_checkbox' => [ qw(setuptax recurtax disabled) ],
+ 'form_select' => [ @form_select ],
+ 'fixup_callback' => sub {
+ #my $ = @_;
+ my $html = '';
+ for my $p ( keys %plans ) {
+ $html .= "if ( what.plan.value == \"$p\" ) {
+ what.setup.value = $plans{$p}->{setup} ;
+ what.recur.value = $plans{$p}->{recur} ;
+ }\n";
+ }
+ $html;
+ },
+ 'layer_callback' => sub {
+ my $layer = shift;
+ my $html = qq!<INPUT TYPE="hidden" NAME="plan" VALUE="$layer">!.
+ ntable("#cccccc",2);
+ my $href = $plans{$layer}->{'fields'};
+ foreach my $field ( exists($plans{$layer}->{'fieldorder'})
+ ? @{$plans{$layer}->{'fieldorder'}}
+ : keys %{ $href }
+ ) {
+
+ $html .= '<TR><TD ALIGN="right">'. $href->{$field}{'name'}. '</TD><TD>';
+
+ if ( ! exists($href->{$field}{'type'}) ) {
+ $html .= qq!<INPUT TYPE="text" NAME="$field" VALUE="!.
+ ( exists($plandata{$field})
+ ? $plandata{$field}
+ : $href->{$field}{'default'} ).
+ qq!" onChange="fchanged(this)">!;
+ } elsif ( $href->{$field}{'type'} eq 'select_multiple' ) {
+ $html .= qq!<SELECT MULTIPLE NAME="$field" onChange="fchanged(this)">!;
+ foreach my $record (
+ qsearch( $href->{$field}{'select_table'},
+ $href->{$field}{'select_hash'} )
+ ) {
+ my $value = $record->getfield($href->{$field}{'select_key'});
+ $html .= qq!<OPTION VALUE="$value"!.
+ ( $plandata{$field} =~ /(^|, *)$value *(,|$)/
+ ? ' SELECTED'
+ : '' ).
+ '>'. $record->getfield($href->{$field}{'select_label'})
+ }
+ $html .= '</SELECT>';
+ }
+
+ $html .= '</TD></TR>';
+ }
+ $html .= '</TABLE>';
+
+ $html .= '<INPUT TYPE="hidden" NAME="plandata" VALUE="'.
+ join(',', keys %{ $href } ). '">'.
+ '<BR><BR>';
+
+ $html .= '<INPUT TYPE="submit" VALUE="'.
+ ( $hashref->{pkgpart} ? "Apply changes" : "Add package" ).
+ '" onClick="fchanged(this)">';
+
+ $html .= '<BR><BR>don\'t edit this unless you know what you\'re doing '.
+ '<INPUT TYPE="button" VALUE="refresh expressions" '.
+ 'onClick="fchanged(this)">'.
+ ntable("#cccccc",2).
+ '<TR><TD>'.
+ '<FONT SIZE="1">Setup expression<BR>'.
+ '<INPUT TYPE="text" NAME="setup" SIZE="160" VALUE="'.
+ $hashref->{setup}. '" onLoad="fchanged(this)">'.
+ '</FONT><BR>'.
+ '<FONT SIZE="1">Recurring espression<BR>'.
+ '<INPUT TYPE="text" NAME="recur" SIZE="160" VALUE="'.
+ $hashref->{recur}. '" onLoad="fchanged(this)">'.
+ '</FONT>'.
+ '</TR></TD>'.
+ '</TABLE>';
+
+ $html;
+
+ },
+);
+
+%>
+
+<BR>
+Price plan <%= $widget->html %>
+ </BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $part_referral;
+if ( $cgi->param('error') ) {
+ $part_referral = new FS::part_referral ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_referral')
+ } );
+} elsif ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $part_referral = qsearchs( 'part_referral', { 'refnum' => $1 } );
+} else { #adding
+ $part_referral = new FS::part_referral {};
+}
+my $action = $part_referral->refnum ? 'Edit' : 'Add';
+my $hashref = $part_referral->hashref;
+
+my $p1 = popurl(1);
+print header("$action Advertising source", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all advertising sources' => popurl(2). "browse/part_referral.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!;
+
+print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!;
+#print "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
+
+print <<END;
+Advertising source <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}">
+END
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{refnum} ? "Apply changes" : "Add advertising source",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+ my $part_svc;
+ my $clone = '';
+ if ( $cgi->param('error') ) { #error
+ $part_svc = new FS::part_svc ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_svc')
+ } );
+ } elsif ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {#clone
+ #$cgi->param('clone') =~ /^(\d+)$/ or die "malformed query: $query";
+ $part_svc = qsearchs('part_svc', { 'svcpart'=>$1 } )
+ or die "unknown svcpart: $1";
+ $clone = $part_svc->svcpart;
+ $part_svc->svcpart('');
+ } elsif ( $cgi->keywords ) { #edit
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/ or die "malformed query: $query";
+ $part_svc=qsearchs('part_svc', { 'svcpart'=>$1 } )
+ or die "unknown svcpart: $1";
+ } else { #adding
+ $part_svc = new FS::part_svc {};
+ }
+ my $action = $part_svc->svcpart ? 'Edit' : 'Add';
+ my $hashref = $part_svc->hashref;
+# my $p_svcdb = $part_svc->svcdb || 'svc_acct';
+
+
+ #" onLoad=\"visualize()\""
+%>
+
+<%= header("$action Service Definition",
+ menubar( 'Main Menu' => $p,
+ 'View all service definitions' => "${p}browse/part_svc.cgi"
+ ),
+ )
+%>
+
+<% if ( $cgi->param('error') ) { %>
+<FONT SIZE="+1" COLOR="#ff0000">Error: <%= $cgi->param('error') %></FONT>
+<% } %>
+
+<FORM NAME="dummy">
+
+ Service Part #<%= $part_svc->svcpart ? $part_svc->svcpart : "(NEW)" %>
+<BR><BR>
+Service <INPUT TYPE="text" NAME="svc" VALUE="<%= $hashref->{svc} %>"><BR>
+Disable new orders <INPUT TYPE="checkbox" NAME="disabled" VALUE="Y"<%= $hashref->{disabled} eq 'Y' ? ' CHECKED' : '' %>><BR>
+<INPUT TYPE="hidden" NAME="svcpart" VALUE="<%= $hashref->{svcpart} %>">
+<BR>
+Services are items you offer to your customers.
+<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts
+ <LI>svc_domain - Domains
+ <LI>svc_acct_sm - <B>deprecated</B> (use svc_forward for new installations) Virtual domain mail aliasing.
+ <LI>svc_forward - mail forwarding
+ <LI>svc_www - Virtual domain website
+<!-- <LI>svc_charge - One-time charges (Partially unimplemented)
+ <LI>svc_wo - Work orders (Partially unimplemented)
+-->
+</UL>
+For the selected table, you can give fields default or fixed (unchangable)
+values. For example, a SLIP/PPP account may have a default (or perhaps fixed)
+<B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed
+blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or
+<B>/usr/bin/passwd</B>.
+<BR><BR>
+
+<%
+#these might belong somewhere else for other user interfaces
+#pry need to eventually create stuff that's shared amount UIs
+my %defs = (
+ 'svc_acct' => {
+ 'dir' => 'Home directory',
+ 'uid' => 'UID (set to fixed and blank for dial-only)',
+ 'slipip' => 'IP address (Set to fixed and blank to disable dialin, or, set a value to be exported to RADIUS Framed-IP-Address. Use the special value <code>0e0</code> [zero e zero] to enable export to RADIUS without a Framed-IP-Address.)',
+# 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
+ 'popnum' => {
+ desc => 'Access number',
+ type => 'select',
+ select_table => 'svc_acct_pop',
+ select_key => 'popnum',
+ select_label => 'city',
+ },
+ 'username' => 'Username',
+ 'quota' => '',
+ '_password' => 'Password',
+ 'gid' => 'GID (when blank, defaults to UID)',
+ 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)',
+ 'finger' => 'GECOS',
+ 'domsvc' => {
+ desc =>'svcnum from svc_domain',
+ type =>'select',
+ select_table => 'svc_domain',
+ select_key => 'svcnum',
+ select_label => 'domain',
+ },
+ 'usergroup' => {
+ desc =>'ICRADIUS/FreeRADIUS groups',
+ type =>'radius_usergroup_selector',
+ },
+ },
+ 'svc_domain' => {
+ 'domain' => 'Domain',
+ },
+ 'svc_acct_sm' => {
+ 'domuser' => 'domuser@virtualdomain.com',
+ 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
+ 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
+ },
+ 'svc_forward' => {
+ 'srcsvc' => 'service from which mail is to be forwarded',
+ 'dstsvc' => 'service to which mail is to be forwarded',
+ 'dst' => 'someone@another.domain.com to use when dstsvc is 0',
+ },
+ 'svc_charge' => {
+ 'amount' => 'amount',
+ },
+ 'svc_wo' => {
+ 'worker' => 'Worker',
+ '_date' => 'Date',
+ },
+ 'svc_www' => {
+ #'recnum' => '',
+ #'usersvc' => '',
+ },
+);
+
+ my @dbs = $hashref->{svcdb}
+ ? ( $hashref->{svcdb} )
+ : qw( svc_acct svc_domain svc_acct_sm svc_forward svc_www );
+
+ tie my %svcdb, 'Tie::IxHash', map { $_=>$_ } @dbs;
+ my $widget = new HTML::Widgets::SelectLayers(
+ #'selected_layer' => $p_svcdb,
+ 'selected_layer' => $hashref->{svcdb} || 'svc_acct',
+ 'options' => \%svcdb,
+ 'form_name' => 'dummy',
+ 'form_action' => 'process/part_svc.cgi',
+ 'form_text' => [ qw( svc svcpart ) ],
+ 'form_checkbox' => [ 'disabled' ],
+ 'layer_callback' => sub {
+ my $layer = shift;
+ my $html = qq!<INPUT TYPE="hidden" NAME="svcdb" VALUE="$layer">!;
+
+ my $columns = 3;
+ my $count = 0;
+ my @part_export =
+ grep { $layer eq FS::part_export::exporttype2svcdb($_->exporttype) }
+ qsearch( 'part_export', {} );
+ $html .= '<BR><BR>'. table().
+ table(). "<TR><TH COLSPAN=$columns>Exports</TH></TR><TR>";
+ foreach my $part_export ( @part_export ) {
+ $html .= '<TD><INPUT TYPE="checkbox"'.
+ ' NAME="exportnum'. $part_export->exportnum. '" VALUE="1" ';
+ $html .= 'CHECKED'
+ if qsearchs( 'export_svc', {
+ exportnum => $part_export->exportnum,
+ svcpart => $clone || $part_svc->svcpart });
+ $html .= '> '. $part_export->exporttype. ' to '. $part_export->machine.
+ '</TD>';
+ $count++;
+ $html .= '</TR><TR>' unless $count % $columns;
+ }
+ $html .= '</TR></TABLE><BR><BR>';
+
+ $html .= table(). "<TH>Field</TH><TH COLSPAN=2>Modifier</TH>";
+ #yucky kludge
+ my @fields = defined( $FS::Record::dbdef->table($layer) )
+ ? grep { $_ ne 'svcnum' } fields($layer)
+ : ();
+ push @fields, 'usergroup' if $layer eq 'svc_acct'; #kludge
+ $part_svc->svcpart($clone) if $clone; #haha, undone below
+ foreach my $field (@fields) {
+ my $part_svc_column = $part_svc->part_svc_column($field);
+ my $value = $cgi->param('error')
+ ? $cgi->param("${layer}__${field}")
+ : $part_svc_column->columnvalue;
+ my $flag = $cgi->param('error')
+ ? $cgi->param("${layer}__${field}_flag")
+ : $part_svc_column->columnflag;
+ my $def = $defs{$layer}{$field};
+ my $desc = ref($def) ? $def->{desc} : $def;
+
+ $html .= "<TR><TD>$field";
+ $html .= "- <FONT SIZE=-1>$desc</FONT>" if $desc;
+ $html .= "</TD>";
+ $html .=
+ qq!<TD><INPUT TYPE="radio" NAME="${layer}__${field}_flag" VALUE=""!.
+ ' CHECKED'x($flag eq ''). ">Off</TD>".
+ qq!<TD><INPUT TYPE="radio" NAME="${layer}__${field}_flag" VALUE="D"!.
+ ' CHECKED'x($flag eq 'D'). ">Default ".
+ qq!<INPUT TYPE="radio" NAME="${layer}__${field}_flag" VALUE="F"!.
+ ' CHECKED'x($flag eq 'F'). ">Fixed ".
+ '<BR>';
+ if ( ref($def) ) {
+ if ( $def->{type} eq 'select' ) {
+ $html .= qq!<SELECT NAME="${layer}__${field}">!;
+ $html .= '<OPTION> </OPTION>' unless $value;
+ foreach my $record ( qsearch( $def->{select_table}, {} ) ) {
+ my $rvalue = $record->getfield($def->{select_key});
+ $html .= qq!<OPTION VALUE="$rvalue"!.
+ ( $rvalue==$value ? ' SELECTED>' : '>' ).
+ $record->getfield($def->{select_label}). '</OPTION>';
+ }
+ $html .= '</SELECT>';
+ } elsif ( $def->{type} eq 'radius_usergroup_selector' ) {
+ $html .= FS::svc_acct::radius_usergroup_selector(
+ [ split(',', $value) ], "${layer}__${field}" );
+ } else {
+ $html .= '<font color="#ff0000">unknown type'. $def->{type};
+ }
+ } else {
+ $html .=
+ qq!<INPUT TYPE="text" NAME="${layer}__${field}" VALUE="$value">!;
+ }
+ $html .= "</TD></TR>\n";
+ }
+ $part_svc->svcpart('') if $clone; #undone
+ $html .= "</TABLE>";
+
+ $html .= '<BR><INPUT TYPE="submit" VALUE="'.
+ ($hashref->{svcpart} ? 'Apply changes' : 'Add service'). '">';
+
+ $html;
+
+ },
+ );
+
+%>
+Table <%= $widget->html %>
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+my $pkgnum = $cgi->param('pkgnum') or die;
+my $old = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+my %hash = $old->hash;
+$hash{'setup'} = $cgi->param('setup') ? str2time($cgi->param('setup')) : '';
+$hash{'bill'} = $cgi->param('bill') ? str2time($cgi->param('bill')) : '';
+my $new = new FS::cust_pkg \%hash;
+
+my $error = $new->replace($old);
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "REAL_cust_pkg.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?". $pkgnum);
+}
+
+%>
--- /dev/null
+<%
+
+my $agentnum = $cgi->param('agentnum');
+
+my $old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
+
+my $new = new FS::agent ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('agent')
+} );
+
+my $error;
+if ( $agentnum ) {
+ $error=$new->replace($old);
+} else {
+ $error=$new->insert;
+ $agentnum=$new->getfield('agentnum');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/agent.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+my $typenum = $cgi->param('typenum');
+my $old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
+
+my $new = new FS::agent_type ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('agent_type')
+} );
+
+my $error;
+if ( $typenum ) {
+ $error=$new->replace($old);
+} else {
+ $error=$new->insert;
+ $typenum=$new->getfield('typenum');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string );
+} else {
+
+ #false laziness w/ edit/process/part_svc.cgi
+ foreach my $part_pkg (qsearch('part_pkg',{})) {
+ my($pkgpart)=$part_pkg->getfield('pkgpart');
+
+ my($type_pkgs)=qsearchs('type_pkgs',{
+ 'typenum' => $typenum,
+ 'pkgpart' => $pkgpart,
+ });
+ if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) {
+ my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below.
+ $error=$d_type_pkgs->delete;
+ die $error if $error;
+
+ } elsif ( $cgi->param("pkgpart$pkgpart")
+ && ! $type_pkgs
+ ) {
+ #ok to clobber it now (but bad form nonetheless?)
+ $type_pkgs=new FS::type_pkgs ({
+ 'typenum' => $typenum,
+ 'pkgpart' => $pkgpart,
+ });
+ $error= $type_pkgs->insert;
+ die $error if $error;
+ }
+
+ }
+
+ print $cgi->redirect(popurl(3). "browse/agent_type.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+$cgi->param('paynum') =~ /^(\d*)$/ or die "Illegal paynum!";
+my $paynum = $1;
+
+my $cust_pay = qsearchs('cust_pay', { 'paynum' => $paynum } )
+ or die "No such paynum";
+
+my $cust_main = qsearchs('cust_main', { 'custnum' => $cust_pay->custnum } )
+ or die "Bogus credit: not attached to customer";
+
+my $custnum = $cust_main->custnum;
+
+my $new = new FS::cust_bill_pay ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(custnum _date amount invnum)
+ } fields('cust_bill_pay')
+} );
+
+my $error = $new->insert;
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_bill_pay.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
+
+
+%>
--- /dev/null
+<%
+
+$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
+my $custnum = $1;
+
+$cgi->param('otaker',getotaker);
+
+my $new = new FS::cust_credit ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(custnum _date amount otaker reason)
+ } fields('cust_credit')
+} );
+
+my $error = $new->insert;
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string );
+} else {
+ if ( $cgi->param('apply') eq 'yes' ) {
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum })
+ or die "unknown custnum $custnum";
+ $cust_main->apply_credits;
+ }
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
+
+
+%>
--- /dev/null
+<%
+
+$cgi->param('crednum') =~ /^(\d*)$/ or die "Illegal crednum!";
+my $crednum = $1;
+
+my $cust_credit = qsearchs('cust_credit', { 'crednum' => $crednum } )
+ or die "No such crednum";
+
+my $cust_main = qsearchs('cust_main', { 'custnum' => $cust_credit->custnum } )
+ or die "Bogus credit: not attached to customer";
+
+my $custnum = $cust_main->custnum;
+
+my $new;
+if ($cgi->param('invnum') =~ /^Refund$/) {
+ $new = new FS::cust_refund ( {
+ 'reason' => $cust_credit->reason,
+ 'refund' => $cgi->param('amount'),
+ 'payby' => 'BILL',
+ #'_date' => $cgi->param('_date'),
+ 'payinfo' => 'Cash',
+ 'crednum' => $crednum,
+ } );
+} else {
+ $new = new FS::cust_credit_bill ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(custnum _date amount invnum)
+ } fields('cust_credit_bill')
+ } );
+}
+
+my $error = $new->insert;
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_credit_bill.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
+
+
+%>
--- /dev/null
+<%
+
+my $error = '';
+
+#unmunge stuff
+
+$cgi->param('tax','') unless defined $cgi->param('tax');
+
+$cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] );
+
+my $payby = $cgi->param('payby');
+if ( $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 );
+
+my @invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') );
+push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST');
+
+#create new record object
+
+my $new = new FS::cust_main ( {
+ map {
+ $_, scalar($cgi->param($_))
+# } qw(custnum agentnum last first ss company address1 address2 city county
+# state zip daytime night fax payby payinfo paydate payname tax
+# otaker refnum)
+ } fields('cust_main')
+} );
+
+if ( defined($cgi->param('same')) && $cgi->param('same') eq "Y" ) {
+ $new->setfield("ship_$_", '') foreach qw(
+ last first company address1 address2 city county state zip
+ country daytime night fax
+ );
+}
+
+#perhaps this stuff should go to cust_main.pm
+my $cust_pkg = '';
+my $svc_acct = '';
+if ( $new->custnum eq '' ) {
+
+ if ( $cgi->param('pkgpart_svcpart') ) {
+ my $x = $cgi->param('pkgpart_svcpart');
+ $x =~ /^(\d+)_(\d+)$/;
+ my($pkgpart, $svcpart) = ($1, $2);
+ #false laziness: copied from FS::cust_pkg::order (which should become a
+ #FS::cust_main method)
+ my(%part_pkg);
+ # generate %part_pkg
+ # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
+ my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum });
+ #my($type_pkgs);
+ #foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ # my($pkgpart)=$type_pkgs->pkgpart;
+ # $part_pkg{$pkgpart}++;
+ #}
+ # $pkgpart_href->{PKGPART} is true iff $custnum may purchase $pkgpart
+ my $pkgpart_href = $agent->pkgpart_hashref;
+ #eslaf
+
+ # this should wind up in FS::cust_pkg!
+ $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't".
+ "purchase pkgpart ". $pkgpart
+ #unless $part_pkg{ $pkgpart };
+ unless $pkgpart_href->{ $pkgpart };
+
+ $cust_pkg = new FS::cust_pkg ( {
+ #later 'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ } );
+ $error ||= $cust_pkg->check;
+
+ #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } );
+
+ #$error ||= $cust_svc->check;
+
+ $svc_acct = new FS::svc_acct ( {
+ 'svcpart' => $svcpart,
+ 'username' => $cgi->param('username'),
+ '_password' => $cgi->param('_password'),
+ 'popnum' => $cgi->param('popnum'),
+ } );
+
+ my $y = $svc_acct->setdefault; # arguably should be in new method
+ $error ||= $y unless ref($y);
+ #and just in case you were silly
+ $svc_acct->svcpart($svcpart);
+ $svc_acct->username($cgi->param('username'));
+ $svc_acct->_password($cgi->param('_password'));
+ $svc_acct->popnum($cgi->param('popnum'));
+
+ $error ||= $svc_acct->check;
+
+ } elsif ( $cgi->param('username') ) { #good thing to catch
+ $error = "Can't assign username without a package!";
+ }
+
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash';
+ %hash = ( $cust_pkg => [ $svc_acct ] ) if $cust_pkg;
+ $error ||= $new->insert( \%hash, \@invoicing_list );
+} else { #create old record object
+ my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } );
+ $error ||= "Old record not found!" unless $old;
+ $error ||= $new->replace($old, \@invoicing_list);
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new->custnum);
+}
+%>
--- /dev/null
+<%
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ or die "Illegal taxnum!";
+my $taxnum = $1;
+my $cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
+ or die ("Unknown taxnum!");
+
+#really should do this in a .pm & start transaction
+
+foreach my $delete ( qsearch('cust_main_county', {
+ 'country' => $cust_main_county->country,
+ 'state' => $cust_main_county->state
+ } ) ) {
+# unless ( qsearch('cust_main',{
+# 'state' => $cust_main_county->getfield('state'),
+# 'county' => $cust_main_county->getfield('county'),
+# 'country' => $cust_main_county->getfield('country'),
+# } ) ) {
+ my $error = $delete->delete;
+ die $error if $error;
+# } else {
+ #should really fix the $cust_main record
+# }
+
+}
+
+$cust_main_county->taxnum('');
+$cust_main_county->county('');
+my $error = $cust_main_county->insert;
+die $error if $error;
+
+print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi");
+
+%>
--- /dev/null
+<%
+
+$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
+my $taxnum = $1;
+my $cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
+ or die ("Unknown taxnum!");
+
+my @expansion;
+if ( $cgi->param('delim') eq 'n' ) {
+ @expansion=split(/\n/,$cgi->param('expansion'));
+} elsif ( $cgi->param('delim') eq 's' ) {
+ @expansion=split(' ',$cgi->param('expansion'));
+} else {
+ die "Illegal delim!";
+}
+
+@expansion=map {
+ unless ( /^\s*([\w\- ]+)\s*$/ ) {
+ $cgi->param('error', "Illegal item in expansion");
+ print $cgi->redirect(popurl(2). "cust_main_county-expand.cgi?". $cgi->query_string );
+ myexit();
+ }
+ $1;
+} @expansion;
+
+foreach ( @expansion) {
+ my(%hash)=$cust_main_county->hash;
+ my($new)=new FS::cust_main_county \%hash;
+ $new->setfield('taxnum','');
+ if ( $cgi->param('taxclass') ) {
+ $new->setfield('taxclass', $_);
+ } elsif ( ! $cust_main_county->state ) {
+ $new->setfield('state',$_);
+ } else {
+ $new->setfield('county',$_);
+ }
+ #if (datasrc =~ m/Pg/)
+ #{
+ # $new->setfield('tax',0.0);
+ #}
+ my($error)=$new->insert;
+ die $error if $error;
+}
+
+unless ( qsearch( 'cust_main', {
+ 'state' => $cust_main_county->state,
+ 'county' => $cust_main_county->county,
+ 'country' => $cust_main_county->country,
+ } )
+ || ! @expansion
+) {
+ my($error)=($cust_main_county->delete);
+ die $error if $error;
+}
+
+print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi");
+
+%>
--- /dev/null
+<%
+
+foreach ( grep { /^tax\d+$/ } $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!";
+ my $exempt_amount = $cgi->param("exempt_amount$taxnum");
+ next unless $old->tax ne $cgi->param("tax$taxnum")
+ || $old->exempt_amount ne $exempt_amount;
+ my %hash = $old->hash;
+ $hash{tax} = $cgi->param("tax$taxnum");
+ $hash{exempt_amount} = $exempt_amount;
+ my($new)=new FS::cust_main_county \%hash;
+ my($error)=$new->replace($old);
+ if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string );
+ myexit();
+ }
+}
+
+print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi");
+
+%>
--- /dev/null
+<%
+
+$cgi->param('linknum') =~ /^(\d+)$/
+ or die "Illegal linknum: ". $cgi->param('linknum');
+my $linknum = $1;
+
+$cgi->param('link') =~ /^(custnum|invnum)$/
+ or die "Illegal link: ". $cgi->param('link');
+my $link = $1;
+
+my $new = new FS::cust_pay ( {
+ $link => $linknum,
+ map {
+ $_, scalar($cgi->param($_));
+ } qw(paid _date payby payinfo paybatch)
+ #} fields('cust_pay')
+} );
+
+my $error = $new->insert;
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). 'cust_pay.cgi?'. $cgi->query_string );
+} elsif ( $link eq 'invnum' ) {
+ print $cgi->redirect(popurl(3). "view/cust_bill.cgi?$linknum");
+} elsif ( $link eq 'custnum' ) {
+ if ( $cgi->param('apply') eq 'yes' ) {
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $linknum })
+ or die "unknown custnum $linknum";
+ $cust_main->apply_payments;
+ }
+ if ( $cgi->param('quickpay') eq 'yes' ) {
+ print $cgi->redirect(popurl(3). "search/cust_main-quickpay.html");
+ } else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$linknum");
+ }
+}
+
+%>
--- /dev/null
+<%
+
+my $error = '';
+
+#untaint custnum
+$cgi->param('custnum') =~ /^(\d+)$/;
+my $custnum = $1;
+
+my @remove_pkgnums = map {
+ /^(\d+)$/ or die "Illegal remove_pkg value!";
+ $1;
+} $cgi->param('remove_pkg');
+
+my @pkgparts;
+foreach my $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) {
+ if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) {
+ my $num_pkgs = $1;
+ while ( $num_pkgs-- ) {
+ push @pkgparts,$pkgpart;
+ }
+ } else {
+ $error = "Illegal quantity";
+ last;
+ }
+}
+
+$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
+
+%>
--- /dev/null
+<%
+
+my $error;
+foreach my $param ( grep { /^\d+$/ } $cgi->param ) {
+ my $old = qsearchs('msgcat', { msgnum=>$param } );
+ next if $old->msg eq $cgi->param($param); #no need to update identical records
+ my $new = new FS::msgcat { $old->hash };
+ $new->msg($cgi->param($param));
+ $error = $new->replace($old);
+ last if $error;
+}
+
+if ( $error ) {
+ $cgi->param('error',$error);
+ print $cgi->redirect($p. "msgcat.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/msgcat.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+my $eventpart = $cgi->param('eventpart');
+
+my $old = qsearchs('part_bill_event',{'eventpart'=>$eventpart}) if $eventpart;
+
+#s/days/seconds/
+$cgi->param('seconds', $cgi->param('days') * 86400 );
+
+my $error;
+if ( ! $cgi->param('plan_weight_eventcode') ) {
+ $error = "Must select an action";
+} else {
+
+ $cgi->param('plan_weight_eventcode') =~ /^([\w\-]+):(\d+):(.*)$/
+ or die "illegal plan_weight_eventcode:".
+ $cgi->param('plan_weight_eventcode');
+ $cgi->param('plan', $1);
+ $cgi->param('weight', $2);
+ my $eventcode = $3;
+ my $plandata = '';
+ while ( $eventcode =~ /%%%(\w+)%%%/ ) {
+ my $field = $1;
+ my $value = $cgi->param($field);
+ $eventcode =~ s/%%%$field%%%/$value/;
+ $plandata .= "$field $value\n";
+ }
+ $cgi->param('eventcode', $eventcode);
+ $cgi->param('plandata', $plandata);
+
+ my $new = new FS::part_bill_event ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('part_bill_event'),
+ } );
+
+ if ( $eventpart ) {
+ $error = $new->replace($old);
+ } else {
+ $error = $new->insert;
+ $eventpart = $new->getfield('eventpart');
+ }
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_bill_event.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3)."browse/part_bill_event.cgi");
+}
+
+%>
+
--- /dev/null
+<%
+
+my $exportnum = $cgi->param('exportnum');
+
+my $old = qsearchs('part_export', { 'exportnum'=>$exportnum } ) if $exportnum;
+
+#fixup options
+#warn join('-', split(',',$cgi->param('options')));
+my %options = map { $_=>$cgi->param($_) } split(',',$cgi->param('options'));
+
+my $new = new FS::part_export ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('part_export')
+} );
+
+my $error;
+if ( $exportnum ) {
+ #warn $old;
+ #warn $exportnum;
+ #warn $new->machine;
+ $error = $new->replace($old,\%options);
+} else {
+ $error = $new->insert(\%options);
+# $exportnum = $new->exportnum;
+}
+
+if ( $error ) {
+ $cgi->param('error', $error );
+ print $cgi->redirect(popurl(2). "part_export.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/part_export.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+my $dbh = dbh;
+
+my $pkgpart = $cgi->param('pkgpart');
+
+my $old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
+
+#fixup plandata
+my $plandata = $cgi->param('plandata');
+my @plandata = split(',', $plandata);
+$cgi->param('plandata',
+ join('', map { "$_=". join(', ', $cgi->param($_)). "\n" } @plandata )
+);
+
+foreach (qw( setuptax recurtax disabled )) {
+ $cgi->param($_, '') unless defined $cgi->param($_);
+}
+
+my $new = new FS::part_pkg ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('part_pkg')
+} );
+
+#warn "setuptax: ". $new->setuptax;
+#warn "recurtax: ". $new->recurtax;
+
+#most of the stuff below should move to part_pkg.pm
+
+foreach my $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 );
+ myexit();
+ }
+}
+
+local $SIG{HUP} = 'IGNORE';
+local $SIG{INT} = 'IGNORE';
+local $SIG{QUIT} = 'IGNORE';
+local $SIG{TERM} = 'IGNORE';
+local $SIG{TSTP} = 'IGNORE';
+local $SIG{PIPE} = 'IGNORE';
+
+local $FS::UID::AutoCommit = 0;
+
+my $error;
+if ( $pkgpart ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $pkgpart=$new->pkgpart;
+}
+if ( $error ) {
+ $dbh->rollback;
+ $cgi->param('error', $error );
+ print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
+ myexit();
+}
+
+foreach my $part_svc (qsearch('part_svc',{})) {
+ my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
+ my $old_pkg_svc = qsearchs('pkg_svc', {
+ 'pkgpart' => $pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ } );
+ my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
+ next unless $old_quantity != $quantity; #!here
+ my $new_pkg_svc = new FS::pkg_svc( {
+ 'pkgpart' => $pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ 'quantity' => $quantity,
+ } );
+ if ( $old_pkg_svc ) {
+ my $myerror = $new_pkg_svc->replace($old_pkg_svc);
+ if ( $myerror ) {
+ $dbh->rollback;
+ die $myerror;
+ }
+ } else {
+ my $myerror = $new_pkg_svc->insert;
+ if ( $myerror ) {
+ $dbh->rollback;
+ die $myerror;
+ }
+ }
+}
+
+unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
+ $dbh->commit or die $dbh->errstr;
+ print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
+} else {
+ my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );
+ my %hash = $old_cust_pkg->hash;
+ $hash{'pkgpart'} = $pkgpart;
+ my($new_cust_pkg) = new FS::cust_pkg \%hash;
+ my $myerror = $new_cust_pkg->replace($old_cust_pkg);
+ if ( $myerror ) {
+ $dbh->rollback;
+ die "Error modifying cust_pkg record: $myerror\n";
+ }
+
+ $dbh->commit or die $dbh->errstr;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
+}
+
+%>
--- /dev/null
+<%
+
+my $refnum = $cgi->param('refnum');
+
+my $new = new FS::part_referral ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('part_referral')
+} );
+
+my $error;
+if ( $refnum ) {
+ my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } );
+ die "(Old) Record not found!" unless $old;
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+}
+$refnum=$new->refnum;
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/part_referral.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+my $svcpart = $cgi->param('svcpart');
+
+my $old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
+
+$cgi->param( 'svc_acct__usergroup',
+ join(',', $cgi->param('svc_acct__usergroup') ) );
+
+my $new = new FS::part_svc ( {
+ map {
+ $_, scalar($cgi->param($_));
+# } qw(svcpart svc svcdb)
+ } ( fields('part_svc'),
+ map { my $svcdb = $_;
+ my @fields = fields($svcdb);
+ push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
+ map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ) } @fields;
+ } grep defined( $FS::Record::dbdef->table($_) ),
+ qw( svc_acct svc_domain svc_acct_sm svc_forward svc_www )
+ )
+} );
+
+my $error;
+if ( $svcpart ) {
+ $error = $new->replace($old, '1.3-COMPAT', [ 'usergroup' ] );
+} else {
+ $error = $new->insert( [ 'usergroup' ] );
+ $svcpart=$new->getfield('svcpart');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string );
+} else {
+
+ #false laziness w/ edit/process/agent_type.cgi
+ foreach my $part_export (qsearch('part_export',{})) {
+ my $exportnum = $part_export->exportnum;
+ my $export_svc = qsearchs('export_svc', {
+ 'exportnum' => $part_export->exportnum,
+ 'svcpart' => $new->svcpart,
+ } );
+ if ( $export_svc && ! $cgi->param("exportnum". $part_export->exportnum) ) {
+ $error = $export_svc->delete;
+ die $error if $error;
+ } elsif ( $cgi->param("exportnum". $part_export->exportnum)
+ && ! $export_svc ) {
+ $export_svc = new FS::export_svc ( {
+ 'exportnum' => $part_export->exportnum,
+ 'svcpart' => $new->svcpart,
+ } );
+ $error = $export_svc->insert;
+ die $error if $error;
+ }
+
+ }
+
+ print $cgi->redirect(popurl(3)."browse/part_svc.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+#untaint custnum
+$cgi->param('custnum') =~ /^(\d+)$/
+ or eidiot 'illegal custnum '. $cgi->param('custnum');
+my $custnum = $1;
+$cgi->param('pkgpart') =~ /^(\d+)$/
+ or eidiot 'illegal pkgpart '. $cgi->param('pkgpart');
+my $pkgpart = $1;
+
+my @cust_pkg = ();
+my $error = FS::cust_pkg::order($custnum, [ $pkgpart ], [], \@cust_pkg, );
+
+if ($error) {
+%>
+<!-- mason kludge -->
+<%
+ eidiot($error);
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?". $cust_pkg[0]->pkgnum );
+}
+
+%>
+
--- /dev/null
+<%
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum = $1;
+
+my $old;
+if ( $svcnum ) {
+ $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } )
+ or die "fatal: can't find account (svcnum $svcnum)!";
+} else {
+ $old = '';
+}
+
+#unmunge popnum
+$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] );
+
+#unmunge passwd
+if ( $cgi->param('_password') eq '*HIDDEN*' ) {
+ die "fatal: no previous account to recall hidden password from!" unless $old;
+ $cgi->param('_password',$old->getfield('_password'));
+}
+
+#unmunge usergroup
+$cgi->param('usergroup', [ $cgi->param('radius_usergroup') ] );
+
+my $new = new FS::svc_acct ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
+ # shell quota slipip)
+ } ( fields('svc_acct'), qw( pkgnum svcpart usergroup ) )
+} );
+
+my $error;
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->svcnum;
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum );
+}
+
+%>
--- /dev/null
+<%
+
+my $popnum = $cgi->param('popnum');
+
+my $old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
+
+my $new = new FS::svc_acct_pop ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('svc_acct_pop')
+} );
+
+my $error = '';
+if ( $popnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $popnum=$new->getfield('popnum');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi");
+}
+
+%>
--- /dev/null
+<%
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum =$1;
+
+my $old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
+
+#unmunge domsvc and domuid
+#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] );
+#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] );
+
+my $new = new FS::svc_acct_sm ( {
+ map {
+ ($_, 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 {
+ $error = $new->insert;
+ $svcnum = $new->getfield('svcnum');
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum");
+}
+
+%>
--- /dev/null
+<%
+
+#remove this to actually test the domains!
+$FS::svc_domain::whois_hack = 1;
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum = $1;
+
+my $new = new FS::svc_domain ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(svcnum pkgnum svcpart domain action purpose)
+ } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) )
+} );
+
+my $error = '';
+if ($cgi->param('svcnum')) {
+ $error="Can't modify a domain!";
+} else {
+ $error=$new->insert;
+ $svcnum=$new->svcnum;
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum");
+}
+
+%>
--- /dev/null
+<%
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum =$1;
+
+my $old = qsearchs('svc_forward',{'svcnum'=>$svcnum}) if $svcnum;
+
+my $new = new FS::svc_forward ( {
+ map {
+ ($_, scalar($cgi->param($_)));
+ } ( fields('svc_forward'), qw( pkgnum svcpart ) )
+} );
+
+my $error = '';
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->getfield('svcnum');
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_forward.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_forward.cgi?$svcnum");
+}
+
+%>
--- /dev/null
+<%
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum = $1;
+
+my $old;
+if ( $svcnum ) {
+ $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } )
+ or die "fatal: can't find account (svcnum $svcnum)!";
+} else {
+ $old = '';
+}
+
+my $new = new FS::svc_www ( {
+ map {
+ ($_, scalar($cgi->param($_)));
+ #} qw(svcnum pkgnum svcpart recnum usersvc)
+ } ( fields('svc_www'), qw( pkgnum svcpart ) )
+} );
+
+my $error;
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->svcnum;
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_www.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_www.cgi?" . $svcnum );
+}
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my @shells = $conf->config('shells');
+
+my($svcnum, $pkgnum, $svcpart, $part_svc, $svc_acct, @groups);
+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;
+ @groups = $cgi->param('radius_usergroup');
+} else {
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_acct) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ @groups = $svc_acct->radius_groups;
+
+ } else { #adding
+
+ $svc_acct = new FS::svc_acct({});
+
+ foreach $_ (split(/-/,$query)) {
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set gecos
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ if ($cust_pkg) {
+ my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
+ unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
+ $svc_acct->setfield('finger',
+ $cust_main->getfield('first') . " " . $cust_main->getfield('last')
+ );
+ }
+ }
+
+ #set fixed and default fields from part_svc
+ foreach my $part_svc_column (
+ grep { $_->columnflag } $part_svc->all_part_svc_column
+ ) {
+ if ( $part_svc_column->columnname eq 'usergroup' ) {
+ @groups = split(',', $part_svc_column->columnvalue);
+ } else {
+ $svc_acct->setfield( $part_svc_column->columnname,
+ $part_svc_column->columnvalue,
+ );
+ }
+ }
+
+ }
+}
+my $action = $svcnum ? 'Edit' : 'Add';
+
+my $svc = $part_svc->getfield('svc');
+
+my $otaker = getotaker;
+
+my $username = $svc_acct->username;
+my $password;
+if ( $svc_acct->_password ) {
+ if ( $conf->exists('showpasswords') || ! $svcnum ) {
+ $password = $svc_acct->_password;
+ } else {
+ $password = "*HIDDEN*";
+ }
+} else {
+ $password = '';
+}
+
+my $ulen = $conf->config('usernamemax')
+ || $svc_acct->dbdef_table->column('username')->length;
+my $ulen2 = $ulen+2;
+
+my $pmax = $conf->config('passwordmax') || 8;
+my $pmax2 = $pmax+2;
+
+my $p1 = popurl(1);
+print header("$action $svc account");
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT><BR><BR>"
+ if $cgi->param('error');
+
+print 'Service # '. ( $svcnum ? "<B>$svcnum</B>" : " (NEW)" ). '<BR>'.
+ 'Service: <B>'. $part_svc->svc. '</B><BR><BR>'.
+ <<END;
+ <FORM NAME="OneTrueForm" 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">
+END
+
+print &ntable("#cccccc",2), <<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=$pmax2 MAXLENGTH=$pmax>
+(blank to generate)</TD>
+</TR>
+END
+
+my $sec_phrase = $svc_acct->sec_phrase;
+if ( $conf->exists('security_phrase') ) {
+ print <<END;
+ <TR><TD ALIGN="right">Security phrase</TD>
+ <TD><INPUT TYPE="text" NAME="sec_phrase" VALUE="$sec_phrase" SIZE=32>
+ (for forgotten passwords)</TD>
+ </TD>
+END
+} else {
+ print qq!<INPUT TYPE="hidden" NAME="sec_phrase" VALUE="$sec_phrase">!;
+}
+
+#domain
+my $domsvc = $svc_acct->domsvc || 0;
+if ( $part_svc->part_svc_column('domsvc')->columnflag eq 'F' ) {
+ print qq!<INPUT TYPE="hidden" NAME="domsvc" VALUE="$domsvc">!;
+} else {
+ my %svc_domain = ();
+
+ if ( $domsvc ) {
+ my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $domsvc, } );
+ if ( $svc_domain ) {
+ $svc_domain{$svc_domain->svcnum} = $svc_domain;
+ } else {
+ warn "unknown svc_domain.svcnum for svc_acct.domsvc: $domsvc";
+ }
+ }
+
+ if ( $part_svc->part_svc_column('domsvc')->columnflag eq 'D' ) {
+ my $svc_domain = qsearchs('svc_domain', {
+ 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue,
+ } );
+ if ( $svc_domain ) {
+ $svc_domain{$svc_domain->svcnum} = $svc_domain;
+ } else {
+ warn "unknown svc_domain.svcnum for part_svc_column domsvc: ".
+ $part_svc->part_svc_column('domsvc')->columnvalue;
+ }
+ }
+
+ my $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $pkgnum } );
+ if ($cust_pkg) {
+ my @cust_svc =
+ map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
+ qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum } );
+ foreach my $cust_svc ( @cust_svc ) {
+ my $svc_domain =
+ qsearchs('svc_domain', { 'svcnum' => $cust_svc->svcnum } );
+ $svc_domain{$svc_domain->svcnum} = $svc_domain if $svc_domain;
+ }
+ } else {
+ %svc_domain = map { $_->svcnum => $_ } qsearch('svc_domain', {} );
+ }
+ print qq!<TR><TD ALIGN="right">Domain</TD>!.
+ qq!<TD><SELECT NAME="domsvc" SIZE=1>\n!;
+ foreach my $svcnum (
+ sort { $svc_domain{$a}->domain cmp $svc_domain{$b}->domain }
+ keys %svc_domain
+ ) {
+ my $svc_domain = $svc_domain{$svcnum};
+ print qq!<OPTION VALUE="!. $svc_domain->svcnum. qq!"!.
+ ( $svc_domain->svcnum == $domsvc ? ' SELECTED' : '' ).
+ '>'. $svc_domain->domain. "\n" ;
+ }
+ print "</SELECT></TD></TR>";
+}
+
+#pop
+my $popnum = $svc_acct->popnum || 0;
+if ( $part_svc->part_svc_column('popnum')->columnflag eq "F" ) {
+ print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
+} else {
+ print qq!<TR><TD ALIGN="right">Access number</TD>!.
+ qq!<TD>!. FS::svc_acct_pop::popselector($popnum). '</TD></TR>';
+}
+
+my($uid,$gid,$finger,$dir)=(
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+);
+
+print <<END;
+<INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
+<INPUT TYPE="hidden" NAME="gid" VALUE="$gid">
+END
+
+if ( !$finger && $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
+ print '<INPUT TYPE="hidden" NAME="finger" VALUE="">';
+} else {
+ print '<TR><TD ALIGN="right">GECOS</TD>'.
+ qq!<TD><INPUT TYPE="text" NAME="finger" VALUE="$finger"></TD></TR>!;
+}
+print qq!<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">!;
+
+my $shell = $svc_acct->shell;
+if ( $part_svc->part_svc_column('shell')->columnflag eq "F"
+ || ( !$shell && $part_svc->part_svc_column('uid')->columnflag eq 'F' )
+ ) {
+ print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
+} else {
+ print qq!<TR><TD ALIGN="right">Shell</TD><TD><SELECT NAME="shell" SIZE=1>!;
+ my($etc_shell);
+ foreach $etc_shell (@shells) {
+ print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">",
+ $etc_shell, "\n";
+ }
+ print "</SELECT></TD></TR>";
+}
+
+my($quota,$slipip)=(
+ $svc_acct->quota,
+ $svc_acct->slipip,
+);
+
+print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!;
+
+if ( $part_svc->part_svc_column('slipip')->columnflag eq "F" ) {
+ print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!;
+} else {
+ print qq!<TR><TD ALIGN="right">IP</TD><TD><INPUT TYPE="text" NAME="slipip" VALUE="$slipip"></TD></TR>!;
+}
+
+foreach my $r ( grep { /^r(adius|[cr])_/ } fields('svc_acct') ) {
+ $r =~ /^^r(adius|[cr])_(.+)$/ or next; #?
+ my $a = $2;
+ if ( $part_svc->part_svc_column($r)->columnflag eq 'F' ) {
+ print qq!<INPUT TYPE="hidden" NAME="$r" VALUE="!.
+ $svc_acct->getfield($r). '">';
+ } else {
+ print qq!<TR><TD ALIGN="right">$FS::raddb::attrib{$a}</TD><TD><INPUT TYPE="text" NAME="$r" VALUE="!.
+ $svc_acct->getfield($r). '"></TD></TR>';
+ }
+}
+
+print '<TR><TD ALIGN="right">RADIUS groups</TD>';
+if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
+ print '<TD BGCOLOR="#ffffff">'. join('<BR>', @groups);
+} else {
+ print '<TD>'. &FS::svc_acct::radius_usergroup_selector( \@groups );
+}
+print '</TD></TR>';
+
+#submit
+print qq!</TABLE><BR><INPUT TYPE="submit" VALUE="Submit">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $svc_acct_pop;
+if ( $cgi->param('error') ) {
+ $svc_acct_pop = new FS::svc_acct_pop ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop')
+ } );
+} elsif ( $cgi->keywords ) { #editing
+ my($query)=$cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
+} else { #adding
+ $svc_acct_pop = new FS::svc_acct_pop {};
+}
+my $action = $svc_acct_pop->popnum ? 'Edit' : 'Add';
+my $hashref = $svc_acct_pop->hashref;
+
+my $p1 = popurl(1);
+print header("$action Access Number", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all Access Numbers' => popurl(2). "browse/svc_acct_pop.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!;
+
+#display
+
+print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!,
+ "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)";
+
+print <<END;
+<PRE>
+City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
+State <INPUT TYPE="text" NAME="state" SIZE=16 MAXLENGTH=16 VALUE="$hashref->{state}">
+Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}">
+Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}">
+Local <INPUT TYPE="text" NAME="loc" SIZE=5 MAXLENGTH=4 VALUE="$hashref->{loc}">
+</PRE>
+END
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{popnum} ? "Apply changes" : "Add Access Number",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($svcnum, $pkgnum, $svcpart, $part_svc, $svc_acct_sm );
+if ( $cgi->param('error') ) {
+ $svc_acct_sm = new FS::svc_acct_sm ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm')
+ } );
+ $svcnum = $svc_acct_sm->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ #$part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ #die "No part_svc entry!" unless $part_svc;
+} else {
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_acct_sm) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ #$part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ #die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_acct_sm = new FS::svc_acct_sm({});
+
+ foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ my $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ foreach my $part_svc_column (
+ grep { $_->columnflag } $part_svc->all_part_svc_column
+ ) {
+ $svc_acct_sm->setfield( $part_svc_column->columnname,
+ $part_svc_column->columnvalue,
+ );
+ }
+
+ }
+}
+my $action = $svc_acct_sm->svcnum ? 'Edit' : 'Add';
+
+my %username = ();
+my %domain = ();
+if ($pkgnum) {
+
+ #find all possible uids (and usernames)
+
+ my @u_acct_svcparts = ();
+ foreach my $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ my($custnum)=$cust_pkg->getfield('custnum');
+ foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
+ #record(s) in cust_svc ( for this
+ #pkgnum ! )
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
+ }
+ }
+ }
+
+ #find all possible domains (and domsvc's)
+
+ my @d_acct_svcparts = ();
+ foreach my $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
+ push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
+ }
+
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@d_acct_svcparts) {
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
+ }
+ }
+ }
+
+} elsif ( $action eq 'Edit' ) {
+
+ my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
+ $username{$svc_acct_sm->uid} = $svc_acct->username;
+
+ my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
+ $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
+
+} else {
+ die "\$action eq Add, but \$pkgnum is null!\n";
+}
+
+my $p1 = popurl(1);
+print header("Mail Alias $action", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST>!;
+
+#display
+
+ #formatting
+ print "<PRE>";
+
+#svcnum
+print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
+print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
+
+#pkgnum
+print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+#svcpart
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
+
+my($domuser,$domsvc,$domuid)=(
+ $svc_acct_sm->domuser,
+ $svc_acct_sm->domsvc,
+ $svc_acct_sm->domuid,
+);
+
+#domuser
+print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
+
+#domsvc
+print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
+foreach $_ (keys %domain) {
+ print "<OPTION", $_ eq $domsvc ? " SELECTED" : "",
+ qq! VALUE="$_">$domain{$_}!;
+}
+print "</SELECT>";
+
+#uid
+print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
+foreach $_ (keys %username) {
+ print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "",
+ qq! VALUE="$_">$username{$_}!;
+}
+print "</SELECT>\@$mydomain mailbox.";
+
+ #formatting
+ print "</PRE>\n";
+
+print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($svcnum, $pkgnum, $svcpart, $kludge_action, $purpose, $part_svc,
+ $svc_domain);
+if ( $cgi->param('error') ) {
+ $svc_domain = new FS::svc_domain ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_domain')
+ } );
+ $svcnum = $svc_domain->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ $kludge_action = $cgi->param('action');
+ $purpose = $cgi->param('purpose');
+ $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
+ die "No part_svc entry!" unless $part_svc;
+} else {
+ $kludge_action = '';
+ $purpose = '';
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_domain) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_domain = new FS::svc_domain({});
+
+ foreach $_ (split(/-/,$query)) {
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ foreach my $part_svc_column (
+ grep { $_->columnflag } $part_svc->all_part_svc_column
+ ) {
+ $svc_domain->setfield( $part_svc_column->columnname,
+ $part_svc_column->columnvalue,
+ );
+ }
+
+ }
+
+}
+my $action = $svcnum ? 'Edit' : 'Add';
+
+my $svc = $part_svc->getfield('svc');
+
+my $otaker = getotaker;
+
+my $domain = $svc_domain->domain;
+
+my $p1 = popurl(1);
+print header("$action $svc", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print <<END;
+ <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST>
+ <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
+ <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
+ <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
+END
+
+print qq!<INPUT TYPE="radio" NAME="action" VALUE="N"!;
+print ' CHECKED' if $kludge_action eq 'N';
+print qq!>New!;
+print qq!<BR><INPUT TYPE="radio" NAME="action" VALUE="M"!;
+print ' CHECKED' if $kludge_action eq 'M';
+print qq!>Transfer!;
+
+print <<END;
+<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26>
+<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="$purpose" SIZE=64>
+<P><INPUT TYPE="submit" VALUE="Submit">
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($svcnum, $pkgnum, $svcpart, $part_svc, $svc_forward);
+if ( $cgi->param('error') ) {
+ $svc_forward = new FS::svc_forward ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_forward')
+ } );
+ $svcnum = $svc_forward->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_forward=qsearchs('svc_forward',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_forward) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_forward = new FS::svc_forward({});
+
+ foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ foreach my $part_svc_column (
+ grep { $_->columnflag } $part_svc->all_part_svc_column
+ ) {
+ $svc_forward->setfield( $part_svc_column->columnname,
+ $part_svc_column->columnvalue,
+ );
+ }
+ }
+
+}
+my $action = $svc_forward->svcnum ? 'Edit' : 'Add';
+
+my %email;
+if ($pkgnum) {
+
+ #find all possible user svcnums (and emails)
+
+ #starting with those currently attached
+ if ( $svc_forward->srcsvc ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_forward->srcsvc } );
+ $email{$svc_forward->srcsvc} = $svc_acct->email;
+ }
+ if ( $svc_forward->dstsvc ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_forward->dstsvc } );
+ $email{$svc_forward->dstsvc} = $svc_acct->email;
+ }
+
+ #and including the rest for this customer
+ my($u_part_svc,@u_acct_svcparts);
+ foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ my($custnum)=$cust_pkg->getfield('custnum');
+ my($i_cust_pkg);
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
+ #record(s) in cust_svc ( for this
+ #pkgnum ! )
+ foreach my $i_cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum,
+ 'svcpart' => $acct_svcpart } )
+ ) {
+ my $svc_acct =
+ qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
+ $email{$svc_acct->svcnum} = $svc_acct->email;
+ }
+ }
+ }
+
+} elsif ( $action eq 'Edit' ) {
+
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svc_forward->srcsvc});
+ $email{$svc_forward->srcsvc} = $svc_acct->email;
+
+ $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svc_forward->dstsvc});
+ $email{$svc_forward->dstsvc} = $svc_acct->email;
+
+} else {
+ die "\$action eq Add, but \$pkgnum is null!\n";
+}
+
+my($srcsvc,$dstsvc,$dst)=(
+ $svc_forward->srcsvc,
+ $svc_forward->dstsvc,
+ $svc_forward->dst,
+);
+
+#display
+
+my $p1 = popurl(1);
+print header("Mail Forward $action", '',
+ " onLoad=\"visualize()\"");
+
+%>
+
+<SCRIPT>
+function visualize(what){
+ if (document.getElementById) {
+ document.getElementById('dother').style.visibility = '<%= $dstsvc ? 'hidden' : 'visible' %>';
+ }
+}
+function fixup(what){
+ if (document.getElementById) {
+ if (document.getElementById('dother').style.visibility == 'hidden') {
+ what.dst.value='';
+ }
+ }
+}
+</SCRIPT>
+
+<%
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_forward.cgi" onSubmit="fixup(this)" METHOD=POST>!;
+
+#svcnum
+print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
+print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
+print qq!<BR>!;
+
+#pkgnum
+print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+#svcpart
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
+
+#srcsvc
+print qq!\n\nMail to <SELECT NAME="srcsvc" SIZE=1>!;
+foreach $_ (keys %email) {
+ print "<OPTION", $_ eq $srcsvc ? " SELECTED" : "",
+ qq! VALUE="$_">$email{$_}!;
+}
+print "</SELECT>";
+
+#dstsvc
+print qq! forwards to <SELECT NAME="dstsvc" SIZE=1 onChange="changed(this)">!;
+foreach $_ (keys %email) {
+ print "<OPTION", $_ eq $dstsvc ? " SELECTED" : "",
+ qq! VALUE="$_">$email{$_}!;
+}
+print "<OPTION", 0 eq $dstsvc ? " SELECTED" : "",
+ qq! VALUE="0">(other)!;
+print "</SELECT> mailbox.";
+
+%>
+
+<SCRIPT>
+var selectchoice = null;
+function changed(what) {
+ selectchoice = what.options[what.selectedIndex].value;
+ if (selectchoice == "0") {
+ if (document.getElementById) {
+ document.getElementById('dother').style.visibility = "visible";
+ }
+ }else{
+ if (document.getElementById) {
+ document.getElementById('dother').style.visibility = "hidden";
+ }
+ }
+}
+if (document.getElementById) {
+ document.write("<DIV ID=\"dother\" STYLE=\"visibility: hidden\">");
+}
+</SCRIPT>
+
+<%
+print qq! Other destination: <INPUT TYPE="text" NAME="dst" VALUE="$dst">!;
+%>
+
+<SCRIPT>
+if (document.getElementById) {
+ document.write("</DIV>");
+}
+</SCRIPT>
+
+<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
+</FORM>
+
+<TAG onLoad="
+ if (document.getElementById) {
+ document.getElementById('dother').style.visibility = '<%= $dstsvc ? 'hidden' : 'visible' %>';
+ document.getElementById('dlabel').style.visibility = '<%= $dstsvc ? 'hidden' : 'visible' %>';
+ }
+">
+
+
+ </BODY>
+</HTML>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my( $svcnum, $pkgnum, $svcpart, $part_svc, $svc_www );
+if ( $cgi->param('error') ) {
+ $svc_www = new FS::svc_www ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_www')
+ } );
+ $svcnum = $svc_www->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_www=qsearchs('svc_www',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_www) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_www = new FS::svc_www({});
+
+ foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ foreach my $part_svc_column (
+ grep { $_->columnflag } $part_svc->all_part_svc_column
+ ) {
+ $svc_www->setfield( $part_svc_column->columnname,
+ $part_svc_column->columnvalue,
+ );
+ }
+
+ }
+}
+my $action = $svc_www->svcnum ? 'Edit' : 'Add';
+
+my( %username, %arec );
+if ($pkgnum) {
+
+ my($u_part_svc,@u_acct_svcparts);
+ foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ my($custnum)=$cust_pkg->getfield('custnum');
+ my($i_cust_pkg);
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
+ #record(s) in cust_svc ( for this
+ #pkgnum ! )
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $username{$svc_acct->getfield('svcnum')}=$svc_acct->getfield('username');
+ }
+ }
+ }
+
+
+ my($d_part_svc,@d_acct_svcparts);
+ foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
+ push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
+ }
+
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@d_acct_svcparts) {
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ my $domain_rec;
+ foreach $domain_rec ( qsearch('domain_record',{
+ 'svcnum' => $svc_domain->svcnum,
+ 'rectype' => 'A' } ),
+ qsearch('domain_record',{
+ 'svcnum' => $svc_domain->svcnum,
+ 'rectype' => 'CNAME'
+ } ) ) {
+ $arec{$domain_rec->recnum} =
+ $domain_rec->reczone eq '@'
+ ? $svc_domain->domain
+ : $domain_rec->reczone. '.'. $svc_domain->domain;
+ }
+ $arec{'@.'. $svc_domain->domain} = $svc_domain->domain
+ unless qsearchs('domain_record', { svcnum => $svc_domain->svcnum,
+ reczone => '@', } );
+ $arec{'www.'. $svc_domain->domain} = 'www.'. $svc_domain->domain
+ unless qsearchs('domain_record', { svcnum => $svc_domain->svcnum,
+ reczone => 'www', } );
+ }
+ }
+ }
+
+} elsif ( $action eq 'Edit' ) {
+
+ my($domain_rec) = qsearchs('domain_record', { 'recnum'=>$svc_www->recnum });
+ $arec{$svc_www->recnum} = join '.', $domain_rec->recdata, $domain_rec->reczone;
+
+} else {
+ die "\$action eq Add, but \$pkgnum is null!\n";
+}
+
+
+my $p1 = popurl(1);
+print header("Web Hosting $action", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_www.cgi" METHOD=POST>!;
+
+#display
+
+
+
+#svcnum
+print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
+print qq!Service #<B>!, $svcnum ? $svcnum : "(NEW)", "</B><BR><BR>";
+
+#pkgnum
+print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+#svcpart
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
+
+my($recnum,$usersvc)=(
+ $svc_www->recnum,
+ $svc_www->usersvc,
+);
+
+print &ntable("#cccccc",2),
+ '<TR><TD ALIGN="right">Zone</TD><TD><SELECT NAME="recnum" SIZE=1>';
+foreach $_ (keys %arec) {
+ print "<OPTION", $_ eq $recnum ? " SELECTED" : "",
+ qq! VALUE="$_">$arec{$_}!;
+}
+print "</SELECT></TD></TR>";
+
+print '<TR><TD ALIGN="right">Username</TD><TD><SELECT NAME="usersvc" SIZE=1>';
+foreach $_ (keys %username) {
+ print "<OPTION", ($_ eq $usersvc) ? " SELECTED" : "",
+ qq! VALUE="$_">$username{$_}!;
+}
+print "</SELECT></TD></TR>";
+
+print '</TABLE><BR><INPUT TYPE="submit" VALUE="Submit">';
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>
+ Freeside Main Menu
+ </TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#FFFFFF">
+ <table width="100%">
+ <tr><td>
+ <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.png">
+ </td><td>
+ <font color="#ff0000" size=7>freeside main menu</font>
+ </td><td align=right valign=bottom>
+ version 1.4.0
+ <BR><A HREF="http://www.sisd.com/freeside">Freeside home page</A>
+ <BR><A HREF="docs/">Documentation</A>
+ <BR><A HREF="classic.html">Classic interface</A>
+ </td></tr>
+ </table>
+
+<BR>
+[<A NAME="customer_service" style="background-color: #cccccc"> Sales / Customer service </A>]
+[ <A HREF="#bookkeeping">Bookkeeping / Collections</A> ]
+[ <A HREF="#reports">Reports</A> ]
+[ <A HREF="#sysadmin">Sysadmin</A> ]
+ <TABLE CELLSPACING=2 CELLPADDING=0 BORDERCOLOR="#000000" WIDTH="100%" BGCOLOR="#eeeeee">
+ <TR><TH BGCOLOR="#cccccc">Sales / Customer service</TH></TR>
+ <TR><TD>
+ <BR><FONT SIZE="+1"><A HREF="edit/cust_main.cgi">New Customer</A></FONT>
+ <BR>
+ <BR><FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="last_on" VALUE="1">Last name <INPUT TYPE="text" NAME="last_text"><SELECT NAME="last_type"><OPTION SELECTED VALUE="All">(all)</OPTION><OPTION>Fuzzy<OPTION>Substring</OPTION><OPTION>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=last">all customers by last name</A></FORM>
+ <FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="company_on" VALUE="1">Company <INPUT TYPE="text" NAME="company_text"><SELECT NAME="last_type"><OPTION SELECTED VALUE="All">(all)</OPTION><OPTION>Fuzzy<OPTION>Substring</OPTION><OPTION>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=company">all customers by company</A></FORM>
+ <FORM ACTION="search/svc_acct.cgi" METHOD="POST">Username <INPUT TYPE="text" NAME="username"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_acct.cgi?username">all accounts by username</A></FORM>
+ <FORM ACTION="search/svc_domain.cgi" METHOD="POST">Domain <INPUT TYPE="text" NAME="domain"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_domain.cgi?domain">all domains</A></FORM>
+<!-- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>-->
+<!-- <LI><A HREF="search/svc_forward.html">mail forwards (by ?)</A>-->
+ <BR>
+ </TD></TR>
+ </TABLE>
+
+
+
+ <BR><BR><BR>
+
+
+[ <A HREF="#customer_service">Sales / Customer service</A> ]
+[<A NAME="bookkeeping" style="background-color: #cccccc"> Bookkeeping / Collections </A>]
+[ <A HREF="#reports">Reports</A> ]
+[ <A HREF="#sysadmin">Sysadmin</A> ]
+ <TABLE CELLSPACING=2 CELLPADDING=0 BORDERCOLOR="#000000" WIDTH="100%" BGCOLOR="#eeeeee">
+ <TR><TH BGCOLOR="#cccccc">Bookkeeping / Collections</TH></TR>
+ <TR><TD>
+ <BR><A HREF="search/cust_main-quickpay.html">Quick payment entry</A>
+ <BR>
+ <BR><FORM ACTION="search/cust_main.cgi" METHOD="POST">Credit card # <INPUT TYPE="hidden" NAME="card_on" VALUE="1"><INPUT TYPE="text" NAME="card"><INPUT TYPE="submit" VALUE="Search"></FORM>
+ <FORM ACTION="search/cust_bill.cgi" METHOD="POST">Invoice # <INPUT TYPE="text" NAME="invnum" SIZE="8"><INPUT TYPE="submit" VALUE="Search"></FORM>
+ <FORM ACTION="search/cust_pay.cgi" METHOD="POST">Check # <INPUT TYPE="text" NAME="payinfo" SIZE="8"><INPUT TYPE="hidden" NAME="payby" VALUE="BILL"><INPUT TYPE="submit" VALUE="Search"></FORM>
+ <BR><A HREF="browse/cust_pay_batch.cgi">View pending credit card batch</A> <BR><BR><A HREF="search/cust_pkg.html">Packages (by next bill date range)</A>
+ <BR><BR>Invoice reports
+ <UL>
+ <LI><a href="search/cust_bill_event.html">Invoice event errors (failed credit cards)</a>
+ <LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>)
+ <LI>30 day open invoices (<A HREF="search/cust_bill.cgi?OPEN30_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN30_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN30_custnum">by customer number</A>)
+ <LI>60 day open invoices (<A HREF="search/cust_bill.cgi?OPEN60_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN60_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN60_custnum">by customer number</A>)
+ <LI>90 day open invoices (<A HREF="search/cust_bill.cgi?OPEN90_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN90_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN90_custnum">by customer number</A>)
+ <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>)
+ <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>)
+ </UL>
+ Financial reports
+ <UL>
+ <LI> <A HREF="search/report_receivables.cgi">current receivables</A>
+ <LI> <A HREF="search/report_tax.html">tax reports</A>
+ <LI> <A HREF="search/report_cc.html">credit card receipts</A>
+ <LI> <A HREF="search/report_credit.html">credit memos</A>
+ </UL>
+ <CENTER><HR WIDTH="94%" NOSHADE></CENTER><BR>
+ <A NAME="admin">Administration</a>
+ <ul>
+ <LI><A HREF="browse/part_pkg.cgi">View/Edit package definitions</A>
+ - One or more services are grouped together into a package and
+ given pricing information. Customers purchase packages, not
+ services.
+<!-- <LI><A HREF="browse/agent_type.cgi">View/Edit agent types</A>
+ - 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 type).
+-->
+ <LI><A HREF="browse/cust_main_county.cgi">View/Edit locales and tax rates</A>
+ - 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/part_bill_event.cgi">View/Edit invoice events</A> - Actions for overdue invoices
+ </ul>
+ <BR>
+ </TD></TR>
+ </TABLE>
+
+
+
+ <BR><BR><BR>
+
+
+
+[ <A HREF="#customer_service">Sales / Customer service</A> ]
+[ <A HREF="#bookkeeping">Bookkeeping / Collections</A> ]
+[<A NAME="reports" style="background-color: #cccccc"> Reports </A>]
+[ <A HREF="#sysadmin">Sysadmin</A> ]
+ <TABLE CELLSPACING=2 CELLPADDING=0 BORDERCOLOR="#000000" WIDTH="100%" BGCOLOR="#eeeeee">
+ <TR><TH BGCOLOR="#cccccc">Reports</TH></TR>
+ <TR><TD>
+ <BR>
+ Auditing pre-Freeside services with no customer record
+ <UL>
+ <LI>unlinked accounts (<A HREF="search/svc_acct.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?UN_username">by username</A>) (<A HREF="search/svc_acct.cgi?UN_uid">by uid</A>)
+ <LI>unlinked mail forwards (<A HREF="search/svc_forward.cgi?UN_svcnum">by service number</A>) (by ?))
+ <LI>unlinked domains (<A HREF="search/svc_domain.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?UN_domain">by domain</A>)
+ </UL>
+ Packages
+ <UL>
+ <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
+ <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
+ <LI><A HREF="search/cust_pkg.html">packages (by next bill date range)</A>
+ </UL>
+ Invoices
+ <UL>
+ <LI><a href="search/cust_bill_event.html">Invoice event errors (failed credit cards)</a>
+ <LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>)
+ <LI>30 day open invoices (<A HREF="search/cust_bill.cgi?OPEN30_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN30_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN30_custnum">by customer number</A>)
+ <LI>60 day open invoices (<A HREF="search/cust_bill.cgi?OPEN60_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN60_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN60_custnum">by customer number</A>)
+ <LI>90 day open invoices (<A HREF="search/cust_bill.cgi?OPEN90_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN90_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN90_custnum">by customer number</A>)
+ <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>)
+ <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>)
+ </UL>
+ Financial reports
+ <UL>
+ <LI> <A HREF="search/report_receivables.cgi">current receivables</A>
+ <LI> <A HREF="search/report_tax.html">tax reports</A>
+ <LI> <A HREF="search/report_cc.html">credit card receipts</A>
+ <LI> <A HREF="search/report_credit.html">credit memos</A>
+ </UL>
+ Customers
+ <UL>
+ <LI><A HREF="search/cust_main-otaker.cgi">Search customers by order-taker</A>
+ </UL>
+ <FORM ACTION="search/sql.cgi" METHOD="POST">SQL query: <TT>SELECT </TT><INPUT TYPE="text" NAME="sql" SIZE=32><INPUT TYPE="submit" VALUE="Query"></FORM>
+
+ <BR>
+ </TD></TR>
+ </TABLE>
+
+
+
+ <BR><BR><BR>
+
+
+[ <A HREF="#customer_service">Sales / Customer service</A> ]
+[ <A HREF="#bookkeeping">Bookkeeping / Collections</A> ]
+[ <A HREF="#reports">Reports</A> ]
+[<A NAME="sysadmin" style="background-color: #cccccc"> Sysadmin </A>]
+ <TABLE CELLSPACING=2 CELLPADDING=0 BORDERCOLOR="#000000" WIDTH="100%" BGCOLOR="#eeeeee">
+ <TR><TH BGCOLOR="#cccccc">Sysadmin</TH></TR>
+ <TR><TD>
+ <BR>
+ <A HREF="browse/nas.cgi">View active NAS ports</A>
+ <BR><A HREF="browse/queue.cgi">View pending job queue</A>
+ <BR><BR><CENTER><HR WIDTH="94%" NOSHADE></CENTER><BR>
+ <A NAME="config" HREF="config/config-view.cgi">Configuration</a><!-- - <font size="+2" color="#ff0000">start here</font> -->
+ <BR><BR><A NAME="admin">Administration</a>
+ <ul>
+ <LI><A HREF="browse/part_export.cgi">View/Edit exports</A>
+ - Provisioning services to external machines, databases and APIs.
+ <LI><A HREF="browse/part_svc.cgi">View/Edit service definitions</A>
+ - Services are items you offer to your customers.
+ <LI><A HREF="browse/part_pkg.cgi">View/Edit package definitions</A>
+ - One or more services are grouped together into a package and
+ given pricing information. Customers purchase packages, not
+ services.
+ <LI><A HREF="browse/agent_type.cgi">View/Edit agent types</A>
+ - 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 type).
+ <LI><A HREF="browse/part_referral.cgi">View/Edit advertising sources</A>
+ - Where a customer heard about your service. Tracked for
+ informational purposes.
+ <LI><A HREF="browse/cust_main_county.cgi">View/Edit locales and tax rates</A>
+ - 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 Access Numbers</A>
+ - Points of Presence
+ <LI><A HREF="browse/part_bill_event.cgi">View/Edit invoice events</A> - Actions for overdue invoices
+ <LI><A HREF="browse/msgcat.cgi">View/Edit message catalog</A> - Change error messages and other customizable labels.
+ </ul>
+ <BR>
+ </TD></TR>
+ </TABLE>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ <BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>
+ </BODY>
+</HTML>
--- /dev/null
+<%
+
+#untaint custnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+my $custnum = $1;
+my $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+die "Can't find customer!\n" unless $cust_main;
+
+my $error = $cust_main->bill(
+# 'time'=>$time
+ );
+#&eidiot($error) if $error;
+
+unless ( $error ) {
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+
+ $error = $cust_main->collect(
+ # 'invoice-time'=>$time,
+ # 'batch_card'=> 'yes',
+ 'batch_card'=> 'no',
+ 'report_badcard'=> 'yes',
+ );
+}
+#&eidiot($error) if $error;
+
+if ( $error ) {
+%>
+<!-- mason kludge -->
+<%
+ &idiot($error);
+} else {
+ print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum");
+}
+%>
--- /dev/null
+<%
+
+my $dbh = dbh;
+
+#untaint svcnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+
+my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+die "Unknown svcnum!" unless $svc_acct;
+
+my $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->pkgnum ne '' && $cust_svc->pkgnum ne '0';
+
+local $SIG{HUP} = 'IGNORE';
+local $SIG{INT} = 'IGNORE';
+local $SIG{QUIT} = 'IGNORE';
+local $SIG{TERM} = 'IGNORE';
+local $SIG{TSTP} = 'IGNORE';
+
+local $FS::UID::AutoCommit = 0;
+
+my $error = $svc_acct->cancel;
+$error ||= $svc_acct->delete;
+$error ||= $cust_svc->delete;
+
+if ( $error ) {
+ $dbh->rollback;
+ %>
+<!-- mason kludge -->
+<%
+ &eidiot($error);
+} else {
+
+ $dbh->commit or die $dbh->errstr;
+
+ print $cgi->redirect(popurl(2));
+}
+
+%>
--- /dev/null
+<%
+
+#untaint pkgnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+my $pkgnum = $1;
+
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+
+my $error = $cust_pkg->cancel;
+eidiot($error) if $error;
+
+print $cgi->redirect($p. "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+
+my($svc_domain, $svcnum, $pkgnum, $svcpart, $part_svc);
+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');
+ $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_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_domain) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else {
+
+ die "Invalid (svc_domain) svcnum!";
+
+ }
+}
+
+my %email;
+if ($pkgnum) {
+
+ #find all possible user svcnums (and emails)
+
+ #starting with that currently attached
+ if ($svc_domain->catchall) {
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svc_domain->catchall});
+ $email{$svc_domain->catchall} = $svc_acct->email;
+ }
+
+ #and including the rest for this customer
+ my($u_part_svc,@u_acct_svcparts);
+ foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ my($custnum)=$cust_pkg->getfield('custnum');
+ my($i_cust_pkg);
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
+ #record(s) in cust_svc ( for this
+ #pkgnum ! )
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $email{$svc_acct->getfield('svcnum')}=$svc_acct->email;
+ }
+ }
+ }
+
+} else {
+
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svc_domain->catchall});
+ $email{$svc_domain->catchall} = $svc_acct->email;
+}
+
+# add an absence of a catchall
+$email{0} = "(none)";
+
+my $p1 = popurl(1);
+print header("Domain Catchall Edit", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/catchall.cgi" METHOD=POST>!;
+
+#display
+
+ #formatting
+ print "<PRE>";
+
+#svcnum
+print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
+print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
+
+#pkgnum
+print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+#svcpart
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
+
+my($domain,$catchall)=(
+ $svc_domain->domain,
+ $svc_domain->catchall,
+);
+
+print qq!<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">!;
+
+#catchall
+print qq!\n\nMail to <I>(anything)</I>@<B>$domain</B> forwards to <SELECT NAME="catchall" SIZE=1>!;
+foreach $_ (keys %email) {
+ print "<OPTION", $_ eq $catchall ? " SELECTED" : "",
+ qq! VALUE="$_">$email{$_}!;
+}
+print "</SELECT>";
+
+ #formatting
+ print "</PRE>\n";
+
+print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<%
+
+#untaint paynum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal paynum";
+my $paynum = $1;
+
+my $cust_pay = qsearchs('cust_pay',{'paynum'=>$paynum});
+my $custnum = $cust_pay->custnum;
+
+my $error = $cust_pay->delete;
+eidiot($error) if $error;
+
+print $cgi->redirect($p. "view/cust_main.cgi?". $custnum);
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+my($custnum, $new_custnum);
+if ( $cgi->param('error') ) {
+ $custnum = $cgi->param('custnum');
+ $new_custnum = $cgi->param('new_custnum');
+} else {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/ or die "Illegal query: $query";
+ $custnum = $1;
+ $new_custnum = '';
+}
+my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+ or die "Customer not found: $custnum";
+
+print header('Delete customer');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print
+ qq!<form action="!, popurl(1), qq!process/delete-customer.cgi" method=post>!,
+ qq!<input type="hidden" name="custnum" value="$custnum">!;
+
+if ( qsearch('cust_pkg', { 'custnum' => $custnum, 'cancel' => '' } ) ) {
+ print "Move uncancelled packages to customer number ",
+ qq!<input type="text" name="new_custnum" value="$new_custnum"><br><br>!;
+}
+
+print <<END;
+This will <b>completely remove</b> all traces of this customer record. This
+is <B>not</B> what you want if this is a real customer who has simply
+canceled service with you. For that, cancel all of the customer's packages.
+(you can optionally hide cancelled customers with the <a href="../docs/config.html#hidecancelledcustomers">hidecancelledcustomers</a> configuration file)
+<br>
+<br>Are you <b>absolutely sure</b> you want to delete this customer?
+<br><input type="submit" value="Yes">
+</form></body></html>
+END
+
+#Deleting a customer you have financial records on (i.e. credits) is
+#typically considered fraudulant bookkeeping. Remember, deleting
+#customers should ONLY be used for completely bogus records. You should
+#NOT delete real customers who simply discontinue service.
+#
+#For real customers who simply discontinue service, cancel all of the
+#customer's packages. Customers with all cancelled packages are not
+#billed. There is no need to take further action to prevent billing on
+#customers with all cancelled packages.
+#
+#Also see the "hidecancelledcustomers" and "hidecancelledpackages"
+#configuration options, which will allow you to surpress the display of
+#cancelled customers and packages, respectively.
+
+%>
--- /dev/null
+<%
+
+#untaint paynum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal exportnum";
+my $exportnum = $1;
+
+my $part_export = qsearchs('part_export',{'exportnum'=>$exportnum});
+
+my $error = $part_export->delete;
+eidiot($error) if $error;
+
+print $cgi->redirect($p. "browse/part_export.cgi");
+
+%>
--- /dev/null
+<%
+
+#untaint date & pkgnum
+
+my $date;
+if ( $cgi->param('date') ) {
+ str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date";
+ $date=$1;
+} else {
+ $date='';
+}
+
+$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
+my $pkgnum = $1;
+
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+my %hash = $cust_pkg->hash;
+$hash{expire}=$date;
+my $new = new FS::cust_pkg ( \%hash );
+my $error = $new->replace($cust_pkg);
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my %link_field = (
+ 'svc_acct' => 'username',
+ 'svc_domain' => 'domain',
+ 'svc_acct_sm' => '',
+ 'svc_charge' => '',
+ 'svc_wo' => '',
+);
+
+my($query) = $cgi->keywords;
+my($pkgnum, $svcpart) = ('', '');
+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};
+
+print header("Link to existing $svc"),
+ qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!;
+
+if ( $link_field ) {
+ print <<END;
+ <INPUT TYPE="hidden" NAME="svcnum" VALUE="">
+ <INPUT TYPE="hidden" NAME="link_field" VALUE="$link_field">
+ $link_field of existing service: <INPUT TYPE="text" NAME="link_value">
+END
+} else {
+ print qq!Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">!;
+}
+
+print <<END;
+<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
+<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
+<P><CENTER><INPUT TYPE="submit" VALUE="Link"></CENTER>
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $lpr = $conf->config('lpr');
+
+#untaint invnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+my $invnum = $1;
+my $cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
+die "Can't find invoice!\n" unless $cust_bill;
+
+ 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');
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
+
+%>
--- /dev/null
+<%
+
+$FS::svc_domain::whois_hack=1;
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+my $svcnum =$1;
+
+my $old = qsearchs('svc_domain',{'svcnum'=>$svcnum}) if $svcnum;
+
+my $new = new FS::svc_domain ( {
+ map {
+ ($_, scalar($cgi->param($_)));
+ } ( fields('svc_domain'), qw( pkgnum svcpart ) )
+} );
+
+$new->setfield('action' => 'M');
+
+my $error;
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->getfield('svcnum');
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "catchall.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum");
+}
+
+%>
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+$cgi->param('custnum') =~ /^(\d+)$/;
+my $custnum = $1;
+my $new_custnum;
+if ( $cgi->param('new_custnum') ) {
+ $cgi->param('new_custnum') =~ /^(\d+)$/
+ or die "Illegal new customer number: ". $cgi->param('new_custnum');
+ $new_custnum = $1;
+} else {
+ $new_custnum = '';
+}
+my $cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+ or die "Customer not found: $custnum";
+
+my $error = $cust_main->delete($new_custnum);
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "delete-customer.cgi?". $cgi->query_string );
+} elsif ( $new_custnum ) {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$new_custnum");
+} else {
+ print $cgi->redirect(popurl(3));
+}
+%>
--- /dev/null
+<%
+
+$cgi->param('pkgnum') =~ /^(\d+)$/;
+my $pkgnum = $1;
+$cgi->param('svcpart') =~ /^(\d+)$/;
+my $svcpart = $1;
+$cgi->param('svcnum') =~ /^(\d*)$/;
+my $svcnum = $1;
+
+unless ( $svcnum ) {
+ my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
+ my($svcdb) = $part_svc->getfield('svcdb');
+ $cgi->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
+ my($svc_x)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') });
+ eidiot("$link_field not found!") unless $svc_x;
+ $svcnum=$svc_x->svcnum;
+}
+
+my $old = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+die "svcnum not found!" unless $old;
+#die "svcnum $svcnum already linked to package ". $old->pkgnum if $old->pkgnum;
+my $new = new FS::cust_svc ({
+ 'svcnum' => $svcnum,
+ 'pkgnum' => $pkgnum,
+ 'svcpart' => $svcpart,
+});
+
+my $error = $new->replace($old);
+
+unless ($error) {
+ #no errors, so let's view this customer.
+ print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum");
+} else {
+%>
+<!-- mason kludge -->
+<%
+ idiot($error);
+}
+
+%>
--- /dev/null
+<%
+
+$cgi->param('action') =~ /^(new|del|(retry|remove) selected)$/
+ or die "Illegal action";
+my $action = $1;
+
+my $job;
+if ( $action eq 'new' || $action eq 'del' ) {
+ $cgi->param('jobnum') =~ /^(\d+)$/ or die "Illegal jobnum";
+ my $jobnum = $1;
+ $job = qsearchs('queue', { 'jobnum' => $1 })
+ or die "unknown jobnum $jobnum";
+}
+
+if ( $action eq 'new' ) {
+ my %hash = $job->hash;
+ $hash{'status'} = 'new';
+ $hash{'statustext'} = '';
+ my $new = new FS::queue \%hash;
+ my $error = $new->replace($job);
+ die $error if $error;
+} elsif ( $action eq 'del' ) {
+ my $error = $job->delete;
+ die $error if $error;
+} elsif ( $action =~ /^(retry|remove) selected$/ ) {
+ foreach my $jobnum (
+ map { /^jobnum(\d+)$/; $1; } grep /^jobnum\d+$/, $cgi->param
+ ) {
+ my $job = qsearchs('queue', { 'jobnum' => $jobnum });
+ if ( $action eq 'retry selected' && $job ) { #new
+ my %hash = $job->hash;
+ $hash{'status'} = 'new';
+ $hash{'statustext'} = '';
+ my $new = new FS::queue \%hash;
+ my $error = $new->replace($job);
+ die $error if $error;
+ } elsif ( $action eq 'remove selected' && $job ) { #del
+ my $error = $job->delete;
+ die $error if $error;
+ }
+ }
+}
+
+print $cgi->redirect(popurl(2). "browse/queue.cgi");
+
+%>
--- /dev/null
+<%
+
+#untaint pkgnum
+my ($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+my $pkgnum = $1;
+
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+
+my $error = $cust_pkg->suspend;
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
+%>
--- /dev/null
+<%
+
+#untaint pkgnum
+my ($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+my $pkgnum = $1;
+
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+
+my $error = $cust_pkg->unsuspend;
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
+%>
--- /dev/null
+<%
+
+my(@cust_bill, $sortby);
+if ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ if ( $query eq 'invnum' ) {
+ $sortby = \*invnum_sort;
+ @cust_bill = qsearch('cust_bill', {} );
+ } elsif ( $query eq 'date' ) {
+ $sortby = \*date_sort;
+ @cust_bill = qsearch('cust_bill', {} );
+ } elsif ( $query eq 'custnum' ) {
+ $sortby = \*custnum_sort;
+ @cust_bill = qsearch('cust_bill', {} );
+ } elsif ( $query eq 'OPEN_invnum' ) {
+ $sortby = \*invnum_sort;
+ @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} );
+ } elsif ( $query eq 'OPEN_date' ) {
+ $sortby = \*date_sort;
+ @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} );
+ } elsif ( $query eq 'OPEN_custnum' ) {
+ $sortby = \*custnum_sort;
+ @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} );
+ } elsif ( $query =~ /^OPEN(\d+)_invnum$/ ) {
+ my $open = $1 * 86400;
+ $sortby = \*invnum_sort;
+ @cust_bill =
+ grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} );
+ } elsif ( $query =~ /^OPEN(\d+)_date$/ ) {
+ my $open = $1 * 86400;
+ $sortby = \*date_sort;
+ @cust_bill =
+ grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} );
+ } elsif ( $query =~ /^OPEN(\d+)_custnum$/ ) {
+ my $open = $1 * 86400;
+ $sortby = \*custnum_sort;
+ @cust_bill =
+ grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} );
+ } else {
+ die "unknown query string $query";
+ }
+} else {
+ $cgi->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
+ my $invnum = $2;
+ @cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum } );
+ $sortby = \*invnum_sort;
+}
+
+if ( scalar(@cust_bill) == 1 ) {
+ my $invnum = $cust_bill[0]->invnum;
+ print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect
+} elsif ( scalar(@cust_bill) == 0 ) {
+%>
+<!-- mason kludge -->
+<%
+ eidiot("Invoice not found.");
+} else {
+%>
+<!-- mason kludge -->
+<%
+ my $total = scalar(@cust_bill);
+ print header("Invoice Search Results", menubar(
+ 'Main Menu', popurl(2)
+ )), "$total matching invoices found<BR>", &table(), <<END;
+ <TR>
+ <TH></TH>
+ <TH>Balance</TH>
+ <TH>Amount</TH>
+ <TH>Date</TH>
+ <TH>Contact name</TH>
+ <TH>Company</TH>
+ </TR>
+END
+
+ my(%saw, $cust_bill);
+ my($tot_balance, $tot_amount) = (0, 0);
+ foreach $cust_bill (
+ sort $sortby grep(!$saw{$_->invnum}++, @cust_bill)
+ ) {
+ my($invnum, $owed, $charged, $date ) = (
+ $cust_bill->invnum,
+ sprintf("%.2f", $cust_bill->owed),
+ sprintf("%.2f", $cust_bill->charged),
+ $cust_bill->_date,
+ );
+ my $pdate = time2str("%b %d %Y", $date);
+
+ $tot_balance += $owed;
+ $tot_amount += $charged;
+
+ my $rowspan = 1;
+
+ my $view = popurl(2). "view/cust_bill.cgi?$invnum";
+ print <<END;
+ <TR>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$invnum</FONT></A></TD>
+ <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view"><FONT SIZE=-1>\$$owed</FONT></A></TD>
+ <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view"><FONT SIZE=-1>\$$charged</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$pdate</FONT></A></TD>
+END
+ my $custnum = $cust_bill->custnum;
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
+ if ( $cust_main ) {
+ my $cview = popurl(2). "view/cust_main.cgi?". $cust_main->custnum;
+ my ( $name, $company ) = (
+ $cust_main->last. ', '. $cust_main->first,
+ $cust_main->company,
+ );
+ print <<END;
+ <TD ROWSPAN=$rowspan><A HREF="$cview"><FONT SIZE=-1>$name</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$cview"><FONT SIZE=-1>$company</FONT></A></TD>
+END
+ } else {
+ print <<END
+ <TD ROWSPAN=$rowspan COLSPAN=2>WARNING: couldn't find cust_main.custnum $custnum (cust_bill.invnum $invnum)</TD>
+END
+ }
+
+ print "</TR>";
+ }
+ $tot_balance = sprintf("%.2f", $tot_balance);
+ $tot_amount = sprintf("%.2f", $tot_amount);
+ print <<END;
+ <TR><TD></TD><TH><FONT SIZE=-1>Total</FONT></TH><TH><FONT SIZE=-1>Total</FONT></TH></TR>
+ <TR><TD></TD><TD ALIGN="right"><FONT SIZE=-1>\$$tot_balance</FONT></TD><TD ALIGN="right"><FONT SIZE=-1>\$$tot_amount</FONT></TD></TD></TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+}
+
+#
+
+sub invnum_sort {
+ $a->invnum <=> $b->invnum;
+}
+
+sub custnum_sort {
+ $a->custnum <=> $b->custnum || $a->invnum <=> $b->invnum;
+}
+
+sub date_sort {
+ $a->_date <=> $b->_date || $a->invnum <=> $b->invnum;
+}
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Invoice Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Invoice Search
+ </FONT>
+ <BR><BR>
+ <FORM ACTION="cust_bill.cgi" METHOD="post">
+ Search for <B>invoice #</B>:
+ <INPUT TYPE="text" NAME="invnum">
+
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+#false laziness with view/cust_bill.cgi
+
+$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
+my $beginning = str2time($1);
+
+$cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/;
+my $ending = str2time($1) + 86400;
+
+my @cust_bill_event =
+ sort { $a->_date <=> $b->_date }
+ qsearch('cust_bill_event', {
+ _date => { op=> '>=', value=>$beginning },
+ statustext => { op=> '!=', value=>'' },
+# i wish...
+# _date => { op=> '<=', value=>$ending },
+ }, '', "AND _date <= $ending");
+
+%>
+
+<%= header('Failed billing events') %>
+
+<%= table() %>
+<TR>
+ <TH>Event</TH>
+ <TH>Date</TH>
+ <TH>Status</TH>
+ <TH>Invoice</TH>
+ <TH>(bill) name</TH>
+ <TH>company</TH>
+<% if ( defined dbdef->table('cust_main')->column('ship_last') ) { %>
+ <TH>(service) name</TH>
+ <TH>company</TH>
+<% } %>
+</TR>
+
+<% foreach my $cust_bill_event ( @cust_bill_event ) {
+ my $status = $cust_bill_event->status;
+ $status .= ': '.$cust_bill_event->statustext if $cust_bill_event->statustext;
+ my $cust_bill = $cust_bill_event->cust_bill;
+ my $cust_main = $cust_bill->cust_main;
+ my $invlink = "${p}view/cust_bill.cgi?". $cust_bill->invnum;
+ my $custlink = "${p}view/cust_main.cgi?". $cust_main->custnum;
+%>
+<TR>
+ <TD><%= $cust_bill_event->part_bill_event->event %></TD>
+ <TD><%= time2str("%a %b %e %T %Y", $cust_bill_event->_date) %></TD>
+ <TD><%= $status %></TD>
+ <TD><A HREF="<%=$invlink%>">Invoice #<%= $cust_bill->invnum %> (<%= time2str("%D", $cust_bill->_date ) %>)</A></TD>
+ <TD><A HREF="<%=$custlink%>"><%= $cust_main->last. ', '. $cust_main->first %></A></TD>
+ <TD><A HREF="<%=$custlink%>"><%= $cust_main->company %></A></TD>
+ <% if ( defined dbdef->table('cust_main')->column('ship_last') ) { %>
+ <TD><A HREF="<%=$custlink%>"><%= $cust_main->ship_last. ', '. $cust_main->ship_first %></A></TD>
+ <TD><A HREF="<%=$custlink%>"><%= $cust_main->ship_company %></A></TD>
+ <% } %>
+</TR>
+<% } %>
+</TABLE>
+
+</BODY></HTML>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Failed billing events</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>Failed billing events</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="cust_bill_event.cgi" METHOD="post">
+ Return <B>failed billing events</B> for period:
+ from <INPUT TYPE="text" NAME="beginning"> <i>m/d/y</i>
+ to <INPUT TYPE="text" NAME="ending"> <i>m/d/y</i>
+
+ <P><INPUT TYPE="submit" VALUE="Get Report">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Customer Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Customer Search
+ </FONT>
+ <BR>
+ <FORM ACTION="cust_main.cgi" METHOD="post">
+ Search for <B>Order taker</B>:
+ <INPUT TYPE="hidden" NAME="otaker_on" VALUE="TRUE">
+ <% my $dbh = dbh;
+ my $sth = dbh->prepare("SELECT DISTINCT otaker FROM cust_main")
+ or eidiot $dbh->errstr;
+ $sth->execute() or eidiot $sth->errstr;
+# my @otakers = map { $_->[0] } @{$sth->selectall_arrayref};
+ %>
+ <SELECT NAME="otaker">
+ <% my $otaker; while ( $otaker = $sth->fetchrow_arrayref ) { %>
+ <OPTION><%= $otaker->[0] %></OTAKER>
+ <% } %>
+ </SELECT>
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Customer Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT 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">
+ <INPUT TYPE="text" NAME="card">
+
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Quick payment entry</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Quick payment entry
+ </FONT>
+ <BR><BR>
+ <FORM ACTION="cust_main.cgi" METHOD="post">
+ <INPUT TYPE="hidden" NAME="quickpay" VALUE="yes">
+ <INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>:
+ <INPUT TYPE="text" NAME="last_text">
+ using search method: <SELECT NAME="last_type">
+ <OPTION SELECTED>All
+ <OPTION>Fuzzy
+ <OPTION>Substring
+ <OPTION>Exact
+ </SELECT>
+
+ <P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>:
+ <INPUT TYPE="text" NAME="company_text">
+ using search methods: <SELECT NAME="company_type">
+ <OPTION SELECTED>All
+ <OPTION>Fuzzy
+ <OPTION>Substring
+ <OPTION>Exact
+ </SELECT>
+
+ <P><INPUT TYPE="submit" VALUE="Search"> Note: Fuzzy searching can take a while. Please be patient.
+
+ </FORM>
+
+ <HR>Explanation of search methods:
+ <UL>
+ <LI><B>All</B> - Try all search methods.
+ <LI><B>Fuzzy</B> - Searches for matches that are close to your text.
+ <LI><B>Substring</B> - Searches for matches that contain your text.
+ <LI><B>Exact</B> - Finds exact matches only, but much faster than the other search methods.
+ </UL>
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $maxrecords = $conf->config('maxsearchrecordsperpage');
+
+#my $cache;
+
+#my $monsterjoin = <<END;
+#cust_main left outer join (
+# ( cust_pkg left outer join part_pkg using(pkgpart)
+# ) left outer join (
+# (
+# (
+# ( cust_svc left outer join part_svc using (svcpart)
+# ) left outer join svc_acct using (svcnum)
+# ) left outer join svc_domain using(svcnum)
+# ) left outer join svc_forward using(svcnum)
+# ) using (pkgnum)
+#) using (custnum)
+#END
+
+#my $monsterjoin = <<END;
+#cust_main left outer join (
+# ( cust_pkg left outer join part_pkg using(pkgpart)
+# ) left outer join (
+# (
+# (
+# ( cust_svc left outer join part_svc using (svcpart)
+# ) left outer join (
+# svc_acct left outer join (
+# select svcnum, domain, catchall from svc_domain
+# ) as svc_acct_domsvc (
+# svc_acct_svcnum, svc_acct_domain, svc_acct_catchall
+# ) on svc_acct.domsvc = svc_acct_domsvc.svc_acct_svcnum
+# ) using (svcnum)
+# ) left outer join svc_domain using(svcnum)
+# ) left outer join svc_forward using(svcnum)
+# ) using (pkgnum)
+#) using (custnum)
+#END
+
+my $limit = '';
+$limit .= "LIMIT $maxrecords" if $maxrecords;
+
+my $offset = $cgi->param('offset') || 0;
+$limit .= " OFFSET $offset" if $offset;
+
+my $total = 0;
+
+my(@cust_main, $sortby, $orderby);
+if ( $cgi->param('browse')
+ || $cgi->param('otaker_on')
+) {
+
+ my %search = ();
+ if ( $cgi->param('browse') ) {
+ my $query = $cgi->param('browse');
+ if ( $query eq 'custnum' ) {
+ $sortby=\*custnum_sort;
+ $orderby = "ORDER BY custnum";
+ } elsif ( $query eq 'last' ) {
+ $sortby=\*last_sort;
+ $orderby = "ORDER BY LOWER(last || ' ' || first)";
+ } elsif ( $query eq 'company' ) {
+ $sortby=\*company_sort;
+ $orderby = "ORDER BY LOWER(company || ' ' || last || ' ' || first )";
+ } else {
+ die "unknown browse field $query";
+ }
+ } else {
+ $sortby = \*last_sort; #??
+ $orderby = "ORDER BY LOWER(last || ' ' || first)"; #??
+ if ( $cgi->param('otaker_on') ) {
+ $cgi->param('otaker') =~ /^(\w{1,32})$/ or eidiot "Illegal otaker\n";
+ $search{otaker} = $1;
+ } else {
+ die "unknown query...";
+ }
+ }
+
+ my $ncancelled = '';
+
+ if ( $cgi->param('showcancelledcustomers') eq '0' #see if it was set by me
+ || ( $conf->exists('hidecancelledcustomers')
+ && ! $cgi->param('showcancelledcustomers') )
+ ) {
+ #grep { $_->ncancelled_pkgs || ! $_->all_pkgs }
+ #needed for MySQL??? OR cust_pkg.cancel = \"\"
+ $ncancelled = "
+ 0 < ( SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum
+ AND ( cust_pkg.cancel IS NULL
+ OR cust_pkg.cancel = 0
+ )
+ )
+ OR 0 = ( SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum
+ )
+ ";
+ }
+
+ #EWWWWWW
+ my $qual = join(' AND ',
+ map { "$_ = ". dbh->quote($search{$_}) } keys %search );
+
+ if ( $ncancelled ) {
+ $qual .= ' AND ' if $qual;
+ $qual .= $ncancelled;
+ }
+
+ $qual = " WHERE $qual" if $qual;
+
+ my $statement = "SELECT COUNT(*) FROM cust_main $qual";
+ my $sth = dbh->prepare($statement)
+ or die dbh->errstr. " doing $statement";
+ $sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
+
+ $total = $sth->fetchrow_arrayref->[0];
+
+ if ( $ncancelled ) {
+ if ( %search ) {
+ $ncancelled = " AND $ncancelled";
+ } else {
+ $ncancelled = " WHERE $ncancelled";
+ }
+ }
+ my @just_cust_main = qsearch('cust_main', \%search, '',
+ "$ncancelled $orderby $limit"
+ );
+
+ @cust_main = @just_cust_main;
+
+# foreach my $cust_main ( @just_cust_main ) {
+#
+# my @one_cust_main;
+# $FS::Record::DEBUG=1;
+# ( $cache, @one_cust_main ) = jsearch(
+# "$monsterjoin",
+# { 'custnum' => $cust_main->custnum },
+# '',
+# '',
+# 'cust_main',
+# 'custnum',
+# );
+# push @cust_main, @one_cust_main;
+# }
+
+} else {
+ @cust_main=();
+ $sortby = \*last_sort;
+
+ push @cust_main, @{&cardsearch}
+ if $cgi->param('card_on') && $cgi->param('card');
+ push @cust_main, @{&lastsearch}
+ if $cgi->param('last_on') && $cgi->param('last_text');
+ push @cust_main, @{&companysearch}
+ if $cgi->param('company_on') && $cgi->param('company_text');
+ push @cust_main, @{&referralsearch}
+ if $cgi->param('referral_custnum');
+
+ if ( $cgi->param('company_on') && $cgi->param('company_text') ) {
+ $sortby = \*company_sort;
+ push @cust_main, @{&companysearch};
+ }
+
+ @cust_main = grep { $_->ncancelled_pkgs || ! $_->all_pkgs } @cust_main
+ if $cgi->param('showcancelledcustomers') eq '0' #see if it was set by me
+ || ( $conf->exists('hidecancelledcustomers')
+ && ! $cgi->param('showcancelledcustomers') );
+
+ my %saw = ();
+ @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
+}
+
+my %all_pkgs;
+if ( $conf->exists('hidecancelledpackages' ) ) {
+ %all_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main;
+} else {
+ %all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main;
+}
+#%all_pkgs = ();
+
+if ( scalar(@cust_main) == 1 && ! $cgi->param('referral_custnum') ) {
+ if ( $cgi->param('quickpay') eq 'yes' ) {
+ print $cgi->redirect(popurl(2). "edit/cust_pay.cgi?quickpay=yes;custnum=". $cust_main[0]->custnum);
+ } else {
+ print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum);
+ }
+ #exit;
+} elsif ( scalar(@cust_main) == 0 ) {
+%>
+<!-- mason kludge -->
+<%
+ eidiot "No matching customers found!\n";
+} else {
+%>
+<!-- mason kludge -->
+<%
+
+ $total ||= scalar(@cust_main);
+ print header("Customer Search Results",menubar(
+ 'Main Menu', popurl(2)
+ )), "$total matching customers found ";
+
+ #begin pager
+ my $pager = '';
+ if ( $total != scalar(@cust_main) && $maxrecords ) {
+ unless ( $offset == 0 ) {
+ $cgi->param('offset', $offset - $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Previous</FONT></B></A> ';
+ }
+ my $poff;
+ my $page;
+ for ( $poff = 0; $poff < $total; $poff += $maxrecords ) {
+ $page++;
+ if ( $offset == $poff ) {
+ $pager .= qq!<FONT SIZE="+2">$page</FONT> !;
+ } else {
+ $cgi->param('offset', $poff);
+ $pager .= qq!<A HREF="!. $cgi->self_url. qq!">$page</A> !;
+ }
+ }
+ unless ( $offset + $maxrecords > $total ) {
+ $cgi->param('offset', $offset + $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Next</FONT></B></A> ';
+ }
+ }
+ #end pager
+
+ if ( $cgi->param('showcancelledcustomers') eq '0' #see if it was set by me
+ || ( $conf->exists('hidecancelledcustomers')
+ && ! $cgi->param('showcancelledcustomers')
+ )
+ ) {
+ $cgi->param('showcancelledcustomers', 1);
+ $cgi->param('offset', 0);
+ print qq!( <a href="!. $cgi->self_url. qq!">show cancelled customers</a> )!;
+ } else {
+ $cgi->param('showcancelledcustomers', 0);
+ $cgi->param('offset', 0);
+ print qq!( <a href="!. $cgi->self_url. qq!">hide cancelled customers</a> )!;
+ }
+ if ( $cgi->param('referral_custnum') ) {
+ $cgi->param('referral_custnum') =~ /^(\d+)$/
+ or eidiot "Illegal referral_custnum\n";
+ my $referral_custnum = $1;
+ my $cust_main = qsearchs('cust_main', { custnum => $referral_custnum } );
+ print '<FORM METHOD=POST>'.
+ qq!<INPUT TYPE="hidden" NAME="referral_custnum" VALUE="$referral_custnum">!.
+ 'referrals of <A HREF="'. popurl(2).
+ "view/cust_main.cgi?$referral_custnum\">$referral_custnum: ".
+ ( $cust_main->company
+ || $cust_main->last. ', '. $cust_main->first ).
+ '</A>';
+ print "\n",<<END;
+ <SCRIPT>
+ function changed(what) {
+ what.form.submit();
+ }
+ </SCRIPT>
+END
+ print ' <SELECT NAME="referral_depth" SIZE="1" onChange="changed(this)">';
+ my $max = 8; #config file
+ $cgi->param('referral_depth') =~ /^(\d*)$/
+ or eidiot "Illegal referral_depth";
+ my $referral_depth = $1;
+
+ foreach my $depth ( 1 .. $max ) {
+ print '<OPTION',
+ ' SELECTED'x($depth == $referral_depth),
+ ">$depth";
+ }
+ print "</SELECT> levels deep".
+ '<NOSCRIPT> <INPUT TYPE="submit" VALUE="change"></NOSCRIPT>'.
+ '</FORM>';
+ }
+
+ print "<BR><BR>". $pager. &table(). <<END;
+ <TR>
+ <TH></TH>
+ <TH>(bill) name</TH>
+ <TH>company</TH>
+END
+
+if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ print <<END;
+ <TH>(service) name</TH>
+ <TH>company</TH>
+END
+}
+
+print <<END;
+ <TH>Packages</TH>
+ <TH COLSPAN=2>Services</TH>
+ </TR>
+END
+
+ my(%saw,$cust_main);
+ my $p = popurl(2);
+ foreach $cust_main (
+ sort $sortby grep(!$saw{$_->custnum}++, @cust_main)
+ ) {
+ my($custnum,$last,$first,$company)=(
+ $cust_main->custnum,
+ $cust_main->getfield('last'),
+ $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 } );
+ my @cust_svc = $_->cust_svc;
+ push @lol_cust_svc, \@cust_svc;
+ $rowspan += scalar(@cust_svc) || 1;
+ }
+
+ #my($rowspan) = scalar(@{$all_pkgs{$custnum}});
+ my $view;
+ if ( defined $cgi->param('quickpay') && $cgi->param('quickpay') eq 'yes' ) {
+ $view = $p. 'edit/cust_pay.cgi?quickpay=yes;custnum='. $custnum;
+ } else {
+ $view = $p. 'view/cust_main.cgi?'. $custnum;
+ }
+ my $pcompany = $company
+ ? qq!<A HREF="$view"><FONT SIZE=-1>$company</FONT></A>!
+ : '<FONT SIZE=-1> </FONT>';
+ print <<END;
+ <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>$pcompany</TD>
+END
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ my($ship_last,$ship_first,$ship_company)=(
+ $cust_main->ship_last || $cust_main->getfield('last'),
+ $cust_main->ship_last ? $cust_main->ship_first : $cust_main->first,
+ $cust_main->ship_last ? $cust_main->ship_company : $cust_main->company,
+ );
+ my $pship_company = $ship_company
+ ? qq!<A HREF="$view"><FONT SIZE=-1>$ship_company</FONT></A>!
+ : '<FONT SIZE=-1> </FONT>';
+ print <<END;
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$ship_last, $ship_first</FONT></A></TD>
+ <TD ROWSPAN=$rowspan>$pship_company</A></TD>
+END
+ }
+
+ my($n1)='';
+ foreach ( @{$all_pkgs{$custnum}} ) {
+ my $pkgnum = $_->pkgnum;
+# my $part_pkg = qsearchs( 'part_pkg', { pkgpart => $_->pkgpart } );
+ my $part_pkg = $_->part_pkg;
+
+ my $pkg = $part_pkg->pkg;
+ my $comment = $part_pkg->comment;
+ my $pkgview = $p. '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) = $p.'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 "</TABLE>$pager</BODY></HTML>";
+
+}
+
+#undef $cache; #does this help?
+
+#
+
+sub last_sort {
+ lc($a->getfield('last')) cmp lc($b->getfield('last'))
+ || lc($a->first) cmp lc($b->first);
+}
+
+sub company_sort {
+ return -1 if $a->company && ! $b->company;
+ return 1 if ! $a->company && $b->company;
+ lc($a->company) cmp lc($b->company)
+ || lc($a->getfield('last')) cmp lc($b->getfield('last'))
+ || lc($a->first) cmp lc($b->first);;
+}
+
+sub custnum_sort {
+ $a->getfield('custnum') <=> $b->getfield('custnum');
+}
+
+sub cardsearch {
+
+ my($card)=$cgi->param('card');
+ $card =~ s/\D//g;
+ $card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n";
+ my($payinfo)=$1;
+
+ [ qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'}) ];
+}
+
+sub referralsearch {
+ $cgi->param('referral_custnum') =~ /^(\d+)$/
+ or eidiot "Illegal referral_custnum";
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $1 } )
+ or eidiot "Customer $1 not found";
+ my $depth;
+ if ( $cgi->param('referral_depth') ) {
+ $cgi->param('referral_depth') =~ /^(\d+)$/
+ or eidiot "Illegal referral_depth";
+ $depth = $1;
+ } else {
+ $depth = 1;
+ }
+ [ $cust_main->referral_cust_main($depth) ];
+}
+
+sub lastsearch {
+ my(%last_type);
+ my @cust_main;
+ foreach ( $cgi->param('last_type') ) {
+ $last_type{$_}++;
+ }
+
+ $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/
+ or eidiot "Illegal last name";
+ my($last)=$1;
+
+ if ( $last_type{'Exact'} || $last_type{'Fuzzy'} ) {
+ push @cust_main, qsearch( 'cust_main',
+ { 'last' => { 'op' => 'ILIKE',
+ 'value' => $last } } );
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'ship_last' => { 'op' => 'ILIKE',
+ 'value' => $last } } )
+ if defined dbdef->table('cust_main')->column('ship_last');
+ }
+
+ if ( $last_type{'Substring'} || $last_type{'All'} ) {
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'last' => { 'op' => 'ILIKE',
+ 'value' => "%$last%" } } );
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'ship_last' => { 'op' => 'ILIKE',
+ 'value' => "%$last%" } } )
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ }
+
+ if ( $last_type{'Fuzzy'} || $last_type{'All'} ) {
+
+ &FS::cust_main::check_and_rebuild_fuzzyfiles;
+ my $all_last = &FS::cust_main::all_last;
+
+ my %last;
+ if ( $last_type{'Fuzzy'} || $last_type{'All'} ) {
+ foreach ( amatch($last, [ qw(i) ], @$all_last) ) {
+ $last{$_}++;
+ }
+ }
+
+ #if ($last_type{'Sound-alike'}) {
+ #}
+
+ foreach ( keys %last ) {
+ push @cust_main, qsearch('cust_main',{'last'=>$_});
+ push @cust_main, qsearch('cust_main',{'ship_last'=>$_})
+ if defined dbdef->table('cust_main')->column('ship_last');
+ }
+
+ }
+
+ \@cust_main;
+}
+
+sub companysearch {
+
+ my(%company_type);
+ my @cust_main;
+ foreach ( $cgi->param('company_type') ) {
+ $company_type{$_}++
+ };
+
+ $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/
+ or eidiot "Illegal company";
+ my($company)=$1;
+
+ if ( $company_type{'Exact'} || $company_type{'Fuzzy'} ) {
+ push @cust_main, qsearch( 'cust_main',
+ { 'company' => { 'op' => 'ILIKE',
+ 'value' => $company } } );
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'ship_company' => { 'op' => 'ILIKE',
+ 'value' => $company } } )
+ if defined dbdef->table('cust_main')->column('ship_last');
+ }
+
+ if ( $company_type{'Substring'} || $company_type{'All'} ) {
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'company' => { 'op' => 'ILIKE',
+ 'value' => "%$company%" } } );
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'ship_company' => { 'op' => 'ILIKE',
+ 'value' => "%$company%" } })
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ }
+
+ if ( $company_type{'Fuzzy'} || $company_type{'All'} ) {
+
+ &FS::cust_main::check_and_rebuild_fuzzyfiles;
+ my $all_company = &FS::cust_main::all_company;
+
+ my %company;
+ if ( $company_type{'Fuzzy'} || $company_type{'All'} ) {
+ foreach ( amatch($company, [ qw(i) ], @$all_company ) ) {
+ $company{$_}++;
+ }
+ }
+
+ #if ($company_type{'Sound-alike'}) {
+ #}
+
+ foreach ( keys %company ) {
+ push @cust_main, qsearch('cust_main',{'company'=>$_});
+ push @cust_main, qsearch('cust_main',{'ship_company'=>$_})
+ if defined dbdef->table('cust_main')->column('ship_last');
+ }
+
+ }
+
+ \@cust_main;
+}
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Customer Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Customer Search
+ </FONT>
+ <BR><BR>
+ <FORM ACTION="cust_main.cgi" METHOD="post">
+ <INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>:
+ <INPUT TYPE="text" NAME="last_text">
+ using search method: <SELECT NAME="last_type">
+ <OPTION SELECTED>All
+ <OPTION>Fuzzy
+ <OPTION>Substring
+ <OPTION>Exact
+ </SELECT>
+
+ <P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>:
+ <INPUT TYPE="text" NAME="company_text">
+ using search methods: <SELECT NAME="company_type">
+ <OPTION SELECTED>All
+ <OPTION>Fuzzy
+ <OPTION>Substring
+ <OPTION>Exact
+ </SELECT>
+
+ <P><INPUT TYPE="submit" VALUE="Search"> Note: Fuzzy searching can take a while. Please be patient.
+
+ </FORM>
+
+ <HR>Explanation of search methods:
+ <UL>
+ <LI><B>All</B> - Try all search methods.
+ <LI><B>Fuzzy</B> - Searches for matches that are close to your text.
+ <LI><B>Substring</B> - Searches for matches that contain your text.
+ <LI><B>Exact</B> - Finds exact matches only, but much faster than the other search methods.
+ </UL>
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+$cgi->param('payinfo') =~ /^\s*(\d+)\s*$/ or die "illegal payinfo";
+my $payinfo = $1;
+$cgi->param('payby') =~ /^(\w+)$/ or die "illegal payby";
+my $payby = $1;
+my @cust_pay = qsearch('cust_pay', { 'payinfo' => $payinfo,
+ 'payby' => $payby } );
+my $sortby = \*date_sort;
+
+if (0) {
+#if ( scalar(@cust_pay) == 1 ) {
+# my $invnum = $cust_bill[0]->invnum;
+# print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect
+} elsif ( scalar(@cust_pay) == 0 ) {
+%>
+<!-- mason kludge -->
+<%
+ idiot("Check # not found.");
+ #exit;
+} else {
+ my $total = scalar(@cust_pay);
+ my $s = $total > 1 ? 's' : '';
+%>
+<!-- mason kludge -->
+<%
+ print header("Check # Search Results", menubar(
+ 'Main Menu', popurl(2)
+ )), "$total matching check$s found<BR>", &table(), <<END;
+ <TR>
+ <TH></TH>
+ <TH>Amount</TH>
+ <TH>Date</TH>
+ <TH>Contact name</TH>
+ <TH>Company</TH>
+ </TR>
+END
+
+ my(%saw, $cust_pay);
+ foreach my $cust_pay (
+ sort $sortby grep(!$saw{$_->paynum}++, @cust_pay)
+ ) {
+ my($paynum, $custnum, $payinfo, $amount, $date ) = (
+ $cust_pay->paynum,
+ $cust_pay->custnum,
+ $cust_pay->payinfo,
+ sprintf("%.2f", $cust_pay->paid),
+ $cust_pay->_date,
+ );
+ my $pdate = time2str("%b %d %Y", $date);
+
+ my $rowspan = 1;
+
+ my $view = popurl(2). "view/cust_main.cgi?". $custnum.
+ "#". $payby. $payinfo;
+
+ print <<END;
+ <TR>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$payinfo</FONT></A></TD>
+ <TD ROWSPAN=$rowspan ALIGN="right"><A HREF="$view"><FONT SIZE=-1>\$$amount</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$pdate</FONT></A></TD>
+END
+ my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
+ if ( $cust_main ) {
+ #my $cview = popurl(2). "view/cust_main.cgi?". $cust_main->custnum;
+ my ( $name, $company ) = (
+ $cust_main->last. ', '. $cust_main->first,
+ $cust_main->company,
+ );
+ print <<END;
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$name</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$company</FONT></A></TD>
+END
+ } else {
+ print <<END
+ <TD ROWSPAN=$rowspan COLSPAN=2>WARNING: couldn't find cust_main.custnum $custnum (cust_pay.paynum $paynum)</TD>
+END
+ }
+
+ print "</TR>";
+ }
+ print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+}
+
+#
+
+#sub invnum_sort {
+# $a->invnum <=> $b->invnum;
+#}
+#
+#sub custnum_sort {
+# $a->custnum <=> $b->custnum || $a->invnum <=> $b->invnum;
+#}
+
+sub date_sort {
+ $a->_date <=> $b->_date || $a->invnum <=> $b->invnum;
+}
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Check # Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Check # Search
+ </FONT>
+ <BR><BR>
+ <FORM ACTION="cust_pay.cgi" METHOD="post">
+ Search for <B>check #</B>:
+ <INPUT TYPE="text" NAME="payinfo">
+ <INPUT TYPE="hidden" NAME="payby" VALUE="BILL">
+ <BR><BR><INPUT TYPE="submit" VALUE="Search">
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $maxrecords = $conf->config('maxsearchrecordsperpage');
+
+my %part_pkg = map { $_->pkgpart => $_ } qsearch('part_pkg', {});
+
+my $limit = '';
+$limit .= "LIMIT $maxrecords" if $maxrecords;
+
+my $offset = $cgi->param('offset') || 0;
+$limit .= " OFFSET $offset" if $offset;
+
+my $total;
+
+my($query) = $cgi->keywords;
+my $sortby;
+my @cust_pkg;
+
+if ( $cgi->param('magic') && $cgi->param('magic') eq 'bill' ) {
+ $sortby=\*bill_sort;
+ my $range = '';
+ if ( $cgi->param('beginning')
+ && $cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/ ) {
+ my $beginning = str2time($1);
+ $range = " WHERE bill >= $beginning ";
+ }
+ if ( $cgi->param('ending')
+ && $cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/ ) {
+ my $ending = str2time($1) + 86400;
+ $range .= ( $range ? ' AND ' : ' WHERE ' ). " bill <= $ending ";
+ }
+
+ #false laziness with below
+ my $statement = "SELECT COUNT(*) FROM cust_pkg $range";
+ warn $statement;
+ my $sth = dbh->prepare($statement)
+ or die dbh->errstr. " doing $statement";
+ $sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
+
+ $total = $sth->fetchrow_arrayref->[0];
+
+ @cust_pkg = qsearch('cust_pkg',{}, '', " $range ORDER BY bill $limit" );
+
+} else {
+
+ my $unconf = '';
+ if ( $query eq 'pkgnum' ) {
+ $sortby=\*pkgnum_sort;
+
+ } elsif ( $query eq 'APKG_pkgnum' ) {
+
+ $sortby=\*pkgnum_sort;
+
+ $unconf = "
+ WHERE 0 <
+ ( SELECT count(*) FROM pkg_svc
+ WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
+ AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
+ WHERE cust_svc.pkgnum = cust_pkg.pkgnum
+ AND cust_svc.svcpart = pkg_svc.svcpart
+ )
+ )
+ ";
+
+ #@cust_pkg=();
+ ##perhaps this should go in cust_pkg as a qsearch-like constructor?
+ #my($cust_pkg);
+ #foreach $cust_pkg (
+ # qsearch('cust_pkg',{}, '', "ORDER BY pkgnum $limit" )
+ #) {
+ # my($flag)=0;
+ # my($pkg_svc);
+ # PKG_SVC:
+ # foreach $pkg_svc (qsearch('pkg_svc',{ 'pkgpart' => $cust_pkg->pkgpart })) {
+ # if ( $pkg_svc->quantity
+ # > scalar(qsearch('cust_svc',{
+ # 'pkgnum' => $cust_pkg->pkgnum,
+ # 'svcpart' => $pkg_svc->svcpart,
+ # }))
+ # )
+ # {
+ # $flag=1;
+ # last PKG_SVC;
+ # }
+ # }
+ # push @cust_pkg, $cust_pkg if $flag;
+ #}
+
+ } else {
+ die "Empty QUERY_STRING!";
+ }
+
+ my $statement = "SELECT COUNT(*) FROM cust_pkg $unconf";
+ my $sth = dbh->prepare($statement)
+ or die dbh->errstr. " doing $statement";
+ $sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
+
+ $total = $sth->fetchrow_arrayref->[0];
+
+ @cust_pkg = qsearch('cust_pkg',{}, '', "$unconf ORDER BY pkgnum $limit" );
+
+}
+
+if ( scalar(@cust_pkg) == 1 ) {
+ my($pkgnum)=$cust_pkg[0]->pkgnum;
+ print $cgi->redirect(popurl(2). "view/cust_pkg.cgi?$pkgnum");
+ #exit;
+} elsif ( scalar(@cust_pkg) == 0 ) { #error
+%>
+<!-- mason kludge -->
+<%
+ eidiot("No packages found");
+} else {
+%>
+<!-- mason kludge -->
+<%
+ $total ||= scalar(@cust_pkg);
+
+ #begin pager
+ my $pager = '';
+ if ( $total != scalar(@cust_pkg) && $maxrecords ) {
+ unless ( $offset == 0 ) {
+ $cgi->param('offset', $offset - $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Previous</FONT></B></A> ';
+ }
+ my $poff;
+ my $page;
+ for ( $poff = 0; $poff < $total; $poff += $maxrecords ) {
+ $page++;
+ if ( $offset == $poff ) {
+ $pager .= qq!<FONT SIZE="+2">$page</FONT> !;
+ } else {
+ $cgi->param('offset', $poff);
+ $pager .= qq!<A HREF="!. $cgi->self_url. qq!">$page</A> !;
+ }
+ }
+ unless ( $offset + $maxrecords > $total ) {
+ $cgi->param('offset', $offset + $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Next</FONT></B></A> ';
+ }
+ }
+ #end pager
+
+ print header('Package Search Results',''),
+ "$total matching packages found<BR><BR>$pager", &table(), <<END;
+ <TR>
+ <TH>Package</TH>
+ <TH><FONT SIZE=-1>Setup</FONT></TH>
+ <TH><FONT SIZE=-1>Next<BR>bill</FONT></TH>
+ <TH><FONT SIZE=-1>Susp.</FONT></TH>
+ <TH><FONT SIZE=-1>Expire</FONT></TH>
+ <TH><FONT SIZE=-1>Cancel</FONT></TH>
+ <TH><FONT SIZE=-1>Cust#</FONT></TH>
+ <TH>(bill) name</TH>
+ <TH>company</TH>
+END
+
+if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ print <<END;
+ <TH>(service) name</TH>
+ <TH>company</TH>
+END
+}
+
+print <<END;
+ <TH COLSPAN=2>Services</TH>
+ </TR>
+END
+
+ my $n1 = '<TR>';
+ my(%saw,$cust_pkg);
+ foreach $cust_pkg (
+ sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg)
+ ) {
+ my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
+ my($pkgnum, $setup, $bill, $susp, $expire, $cancel,
+ $custnum, $last, $first, $company ) = (
+ $cust_pkg->pkgnum,
+ $cust_pkg->getfield('setup')
+ ? time2str("%D", $cust_pkg->getfield('setup') )
+ : '',
+ $cust_pkg->getfield('bill')
+ ? time2str("%D", $cust_pkg->getfield('bill') )
+ : '',
+ $cust_pkg->getfield('susp')
+ ? time2str("%D", $cust_pkg->getfield('susp') )
+ : '',
+ $cust_pkg->getfield('expire')
+ ? time2str("%D", $cust_pkg->getfield('expire') )
+ : '',
+ $cust_pkg->getfield('cancel')
+ ? time2str("%D", $cust_pkg->getfield('cancel') )
+ : '',
+ $cust_pkg->custnum,
+ $cust_main ? $cust_main->last : '',
+ $cust_main ? $cust_main->first : '',
+ $cust_main ? $cust_main->company : '',
+ );
+ my($ship_last, $ship_first, $ship_company);
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ ($ship_last, $ship_first, $ship_company) = (
+ $cust_main
+ ? ( $cust_main->ship_last || $cust_main->getfield('last') )
+ : '',
+ $cust_main
+ ? ( $cust_main->ship_last
+ ? $cust_main->ship_first
+ : $cust_main->first )
+ : '',
+ $cust_main
+ ? ( $cust_main->ship_last
+ ? $cust_main->ship_company
+ : $cust_main->company )
+ : '',
+ );
+ }
+ my $pkg = $part_pkg{$cust_pkg->pkgpart}->pkg;
+ #$pkg .= ' - '. $part_pkg{$cust_pkg->pkgpart}->comment;
+ my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } );
+ my $rowspan = scalar(@cust_svc) || 1;
+ my $p = popurl(2);
+ print $n1, <<END;
+ <TD ROWSPAN=$rowspan><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum - $pkg</FONT></A></TD>
+ <TD>$setup</TD>
+ <TD>$bill</TD>
+ <TD>$susp</TD>
+ <TD>$expire</TD>
+ <TD>$cancel</TD>
+END
+ if ( $cust_main ) {
+ print <<END;
+ <TD ROWSPAN=$rowspan><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$custnum</A></FONT></TD>
+ <TD ROWSPAN=$rowspan><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$last, $first</A></FONT></TD>
+ <TD ROWSPAN=$rowspan><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$company</A></FONT></TD>
+END
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ print <<END;
+ <TD ROWSPAN=$rowspan><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$ship_last, $ship_first</A></FONT></TD>
+ <TD ROWSPAN=$rowspan><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$ship_company</A></FONT></TD>
+END
+ }
+ } else {
+ my $colspan = defined dbdef->table('cust_main')->column('ship_last')
+ ? 5 : 3;
+ print <<END;
+ <TD ROWSPAN=$rowspan COLSPAN=$colspan>WARNING: couldn't find cust_main.custnum $custnum (cust_pkg.pkgnum $pkgnum)</TD>
+END
+ }
+
+ my $n2 = '';
+ foreach my $cust_svc ( @cust_svc ) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ my $svcnum = $cust_svc->svcnum;
+ my $sview = $p. "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>';
+
+ print "</TABLE>$pager</BODY></HTML>";
+
+}
+
+sub pkgnum_sort {
+ $a->getfield('pkgnum') <=> $b->getfield('pkgnum');
+}
+
+sub bill_sort {
+ $a->getfield('bill') <=> $b->getfield('bill');
+}
+
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Packages</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>Packages</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="cust_pkg.cgi" METHOD="post">
+ <INPUT TYPE="hidden" NAME="magic" VALUE="bill">
+ Return <B>packages</B> with next bill date:
+ from <INPUT TYPE="text" NAME="beginning"> <i>m/d/y</i>
+ to <INPUT TYPE="text" NAME="ending"> <i>m/d/y</i>
+
+ <P><INPUT TYPE="submit" VALUE="Get Report">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $user = getotaker;
+
+$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
+my $beginning = $1;
+
+$cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/;
+my $ending = $1;
+
+print header('Credit Card Recipt Report Results');
+
+open (REPORT, "freeside-cc-receipts-report -v -s $beginning -f $ending $user |");
+
+print '<PRE>';
+while(<REPORT>) {
+ print $_;
+}
+print '</PRE>';
+
+print '</BODY></HTML>';
+
+%>
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Credit Card Receipt Report Criteria</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>Credit Card Receipt Report Criteria</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="report_cc.cgi" METHOD="post">
+ Return <B>credit card receipt report</B> for period:
+ from <INPUT TYPE="text" NAME="beginning"> <i>m/d/y</i>
+ to <INPUT TYPE="text" NAME="ending"> <i>m/d/y</i>
+
+ <P><INPUT TYPE="submit" VALUE="Get Report">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $user = getotaker;
+
+$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
+my $beginning = $1;
+
+$cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/;
+my $ending = $1;
+
+print header('In House Credit Report Results');
+
+open (REPORT, "freeside-credit-report -v -s $beginning -f $ending $user |");
+
+print '<PRE>';
+while(<REPORT>) {
+ print $_;
+}
+print '</PRE>';
+
+print '</BODY></HTML>';
+
+%>
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>In House Credit Report Criteria</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>In House Credit Report Criteria</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="report_credit.cgi" METHOD="post">
+ Return <B>in house credit report</B> for period:
+ from <INPUT TYPE="text" NAME="beginning"> <i>m/d/y</i>
+ to <INPUT TYPE="text" NAME="ending"> <i>m/d/y</i>
+
+ <P><INPUT TYPE="submit" VALUE="Get Report">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $user = getotaker;
+
+print header('Current Receivables Report Results');
+
+open (REPORT, "freeside-receivables-report -v $user |");
+
+print '<PRE>';
+while(<REPORT>) {
+ print $_;
+}
+print '</PRE>';
+
+print '</BODY></HTML>';
+
+%>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $user = getotaker;
+
+$cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/;
+my $beginning = $1;
+
+$cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/;
+my $ending = $1;
+
+print header('Tax Report Results');
+
+open (REPORT, "freeside-tax-report -v -s $beginning -f $ending $user |");
+
+print '<PRE>';
+while(<REPORT>) {
+ print $_;
+}
+print '</PRE>';
+
+print '</BODY></HTML>';
+
+%>
+
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Tax Report Criteria</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>Tax Report Criteria</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="report_tax.cgi" METHOD="post">
+ Return <B>tax report</B> for period:
+ from <INPUT TYPE="text" NAME="beginning"> <i>m/d/y</i>
+ to <INPUT TYPE="text" NAME="ending"> <i>m/d/y</i>
+
+ <P><INPUT TYPE="submit" VALUE="Get Report">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $maxrecords = $conf->config('maxsearchrecordsperpage');
+
+my $limit = '';
+$limit .= "LIMIT $maxrecords" if $maxrecords;
+
+my $offset = $cgi->param('offset') || 0;
+$limit .= " OFFSET $offset" if $offset;
+
+my $total;
+
+my $sql = $cgi->param('sql');
+$sql =~ s/^\s*SELECT//i;
+
+my $count_sql = $sql;
+$count_sql =~ s/^(.*)\s+FROM\s/COUNT(*) FROM /i;
+
+my $sth = dbh->prepare("SELECT $count_sql")
+ or eidiot dbh->errstr. " doing $count_sql\n";
+$sth->execute or eidiot "Error executing \"$count_sql\": ". $sth->errstr;
+
+$total = $sth->fetchrow_arrayref->[0];
+
+my $sth = dbh->prepare("SELECT $sql $limit")
+ or eidiot dbh->errstr. " doing $sql\n";
+$sth->execute or eidiot "Error executing \"$sql\": ". $sth->errstr;
+my $rows = $sth->fetchall_arrayref;
+
+%>
+<!-- mason kludge -->
+<%
+
+ #begin pager
+ my $pager = '';
+ if ( $total != scalar(@$rows) && $maxrecords ) {
+ unless ( $offset == 0 ) {
+ $cgi->param('offset', $offset - $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Previous</FONT></B></A> ';
+ }
+ my $poff;
+ my $page;
+ for ( $poff = 0; $poff < $total; $poff += $maxrecords ) {
+ $page++;
+ if ( $offset == $poff ) {
+ $pager .= qq!<FONT SIZE="+2">$page</FONT> !;
+ } else {
+ $cgi->param('offset', $poff);
+ $pager .= qq!<A HREF="!. $cgi->self_url. qq!">$page</A> !;
+ }
+ }
+ unless ( $offset + $maxrecords > $total ) {
+ $cgi->param('offset', $offset + $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Next</FONT></B></A> ';
+ }
+ }
+ #end pager
+
+ print header('Query Results', menubar('Main Menu'=>$p) ).
+ "$total total rows<BR><BR>$pager". table().
+ "<TR>";
+ print "<TH>$_</TH>" foreach @{$sth->{NAME}};
+ print "</TR>";
+
+ foreach $row ( @$rows ) {
+ print "<TR>";
+ print "<TD>$_</TD>" foreach @$row;
+ print "</TR>";
+ }
+
+ print "</TABLE>$pager</BODY></HTML>";
+
+%>
--- /dev/null
+<%
+
+my $mydomain = '';
+
+my $conf = new FS::Conf;
+my $maxrecords = $conf->config('maxsearchrecordsperpage');
+
+my $orderby = ''; #removeme
+
+my $limit = '';
+$limit .= "LIMIT $maxrecords" if $maxrecords;
+
+my $offset = $cgi->param('offset') || 0;
+$limit .= " OFFSET $offset" if $offset;
+
+my $total;
+
+my($query)=$cgi->keywords;
+$query ||= ''; #to avoid use of unitialized value errors
+
+my $unlinked = '';
+if ( $query =~ /^UN_(.*)$/ ) {
+ $query = $1;
+ my $empty = driver_name =~ /^Pg$/i ? qq('') : qq("");
+ $unlinked = "
+ WHERE 0 <
+ ( SELECT count(*) FROM cust_svc
+ WHERE cust_svc.svcnum = svc_acct.svcnum
+ AND ( pkgnum IS NULL OR pkgnum = 0 OR pkgnum = $empty )
+ )
+ ";
+}
+
+my(@svc_acct, $sortby);
+if ( $query eq 'svcnum' ) {
+ $sortby=\*svcnum_sort;
+ $orderby = 'ORDER BY svcnum';
+} elsif ( $query eq 'username' ) {
+ $sortby=\*username_sort;
+ $orderby = 'ORDER BY username';
+} elsif ( $query eq 'uid' ) {
+ $sortby=\*uid_sort;
+ $orderby = ( $unlinked ? 'AND' : 'WHERE' ). ' uid IS NOT NULL ORDER BY uid';
+} else {
+ $sortby=\*uid_sort;
+ @svc_acct = @{&usernamesearch};
+}
+
+if ( $query eq 'svcnum' || $query eq 'username' || $query eq 'uid' ) {
+
+ my $statement = "SELECT COUNT(*) FROM svc_acct $unlinked";
+ my $sth = dbh->prepare($statement)
+ or die dbh->errstr. " doing $statement";
+ $sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
+
+ $total = $sth->fetchrow_arrayref->[0];
+
+ @svc_acct = qsearch('svc_acct', {}, '', "$unlinked $orderby $limit");
+
+}
+
+if ( scalar(@svc_acct) == 1 ) {
+ my($svcnum)=$svc_acct[0]->svcnum;
+ print $cgi->redirect(popurl(2). "view/svc_acct.cgi?$svcnum"); #redirect
+ #exit;
+} elsif ( scalar(@svc_acct) == 0 ) { #error
+%>
+<!-- mason kludge -->
+<%
+ idiot("Account not found");
+} else {
+%>
+<!-- mason kludge -->
+<%
+ $total ||= scalar(@svc_acct);
+
+ #begin pager
+ my $pager = '';
+ if ( $total != scalar(@svc_acct) && $maxrecords ) {
+ unless ( $offset == 0 ) {
+ $cgi->param('offset', $offset - $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Previous</FONT></B></A> ';
+ }
+ my $poff;
+ my $page;
+ for ( $poff = 0; $poff < $total; $poff += $maxrecords ) {
+ $page++;
+ if ( $offset == $poff ) {
+ $pager .= qq!<FONT SIZE="+2">$page</FONT> !;
+ } else {
+ $cgi->param('offset', $poff);
+ $pager .= qq!<A HREF="!. $cgi->self_url. qq!">$page</A> !;
+ }
+ }
+ unless ( $offset + $maxrecords > $total ) {
+ $cgi->param('offset', $offset + $maxrecords);
+ $pager .= '<A HREF="'. $cgi->self_url.
+ '"><B><FONT SIZE="+1">Next</FONT></B></A> ';
+ }
+ }
+ #end pager
+
+ print header("Account Search Results",menubar('Main Menu'=>popurl(2))),
+ "$total matching accounts found<BR><BR>$pager",
+ &table(), <<END;
+ <TR>
+ <TH><FONT SIZE=-1>#</FONT></TH>
+ <TH><FONT SIZE=-1>Username</FONT></TH>
+ <TH><FONT SIZE=-1>Domain</FONT></TH>
+ <TH><FONT SIZE=-1>UID</FONT></TH>
+ <TH><FONT SIZE=-1>Service</FONT></TH>
+ <TH><FONT SIZE=-1>Cust#</FONT></TH>
+ <TH><FONT SIZE=-1>(bill) name</FONT></TH>
+ <TH><FONT SIZE=-1>company</FONT></TH>
+END
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ print <<END;
+ <TH><FONT SIZE=-1>(service) name</FONT></TH>
+ <TH><FONT SIZE=-1>company</FONT></TH>
+END
+ }
+ print "</TR>";
+
+ my(%saw,$svc_acct);
+ my $p = popurl(2);
+ foreach $svc_acct (
+ sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct)
+ ) {
+ my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct->svcnum })
+ or die "No cust_svc record for svcnum ". $svc_acct->svcnum;
+ my $part_svc = qsearchs('part_svc', { 'svcpart' => $cust_svc->svcpart })
+ or die "No part_svc record for svcpart ". $cust_svc->svcpart;
+
+ my $domain;
+ my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $svc_acct->domsvc });
+ if ( $svc_domain ) {
+ $domain = "<A HREF=\"${p}view/svc_domain.cgi?". $svc_domain->svcnum.
+ "\">". $svc_domain->domain. "</A>";
+ } else {
+ unless ( $mydomain ) {
+ my $conf = new FS::Conf;
+ unless ( $mydomain = $conf->config('domain') ) {
+ die "No legacy domain config file and no svc_domain.svcnum record ".
+ "for svc_acct.domsvc: ". $svc_acct->domsvc;
+ }
+ }
+ $domain = "<i>$mydomain</i><FONT COLOR=\"#FF0000\">*</FONT>";
+ }
+ my($cust_pkg,$cust_main);
+ if ( $cust_svc->pkgnum ) {
+ $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc->pkgnum })
+ or die "No cust_pkg record for pkgnum ". $cust_svc->pkgnum;
+ $cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg->custnum })
+ or die "No cust_main record for custnum ". $cust_pkg->custnum;
+ }
+ my($svcnum, $username, $uid, $svc, $custnum, $last, $first, $company) = (
+ $svc_acct->svcnum,
+ $svc_acct->getfield('username'),
+ $svc_acct->getfield('uid'),
+ $part_svc->svc,
+ $cust_svc->pkgnum ? $cust_main->custnum : '',
+ $cust_svc->pkgnum ? $cust_main->getfield('last') : '',
+ $cust_svc->pkgnum ? $cust_main->getfield('first') : '',
+ $cust_svc->pkgnum ? $cust_main->company : '',
+ );
+ my($pcustnum) = $custnum
+ ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
+ : "<I>(unlinked)</I>"
+ ;
+ 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>" : '';
+ my($pship_name, $pship_company);
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ my($ship_last, $ship_first, $ship_company) = (
+ $cust_svc->pkgnum ? ( $cust_main->ship_last || $last ) : '',
+ $cust_svc->pkgnum ? ( $cust_main->ship_last
+ ? $cust_main->ship_first
+ : $first
+ ) : '',
+ $cust_svc->pkgnum ? ( $cust_main->ship_last
+ ? $cust_main->ship_company
+ : $company
+ ) : '',
+ );
+ $pship_name = $custnum ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\">$ship_last, $ship_first</A>" : '';
+ $pship_company = $custnum ? "<A HREF=\"${p}view/cust_main.cgi?$custnum\">$ship_company</A>" : '';
+ }
+ print <<END;
+ <TR>
+ <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
+ <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$username</FONT></A></TD>
+ <TD><FONT SIZE=-1>$domain</FONT></TD>
+ <TD><A HREF="${p}view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$uid</FONT></A></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>$pcompany</FONT></TH>
+END
+ if ( defined dbdef->table('cust_main')->column('ship_last') ) {
+ print <<END;
+ <TD><FONT SIZE=-1>$pship_name<FONT></TH>
+ <TD><FONT SIZE=-1>$pship_company</FONT></TH>
+END
+ }
+ print "</TR>";
+
+ }
+
+ print "</TABLE>$pager<BR>";
+
+ if ( $mydomain ) {
+ print "<BR><FONT COLOR=\"#FF0000\">*</FONT> The <I>$mydomain</I> domain ".
+ "is contained in your legacy <CODE>domain</CODE> ".
+ "<A HREF=\"${p}docs/config.html#domain\">configuration file</A>. ".
+ "You should run the <CODE>bin/fs-migrate-svc_acct_sm</CODE> script ".
+ "to create a proper svc_domain record for this domain.";
+ }
+
+ print '</BODY></HTML>';
+
+}
+
+sub svcnum_sort {
+ $a->getfield('svcnum') <=> $b->getfield('svcnum');
+}
+
+sub username_sort {
+ $a->getfield('username') cmp $b->getfield('username');
+}
+
+sub uid_sort {
+ $a->getfield('uid') <=> $b->getfield('uid');
+}
+
+sub usernamesearch {
+
+ $cgi->param('username') =~ /^([\w\-\.\&]+)$/; #untaint username_text
+ my($username)=$1;
+
+ [ qsearch('svc_acct',{'username'=>$username}) ];
+
+}
+
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Account Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Account Search
+ </FONT>
+ <BR><BR>
+ <FORM ACTION="svc_acct.cgi" METHOD="post">
+ Search for <B>username</B>:
+ <INPUT TYPE="text" NAME="username">
+
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+$cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
+my $domuser = $1;
+
+$cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
+my $svc_domain = qsearchs('svc_domain',{'domain'=>$1})
+ or die "Unknown domain";
+my $domsvc = $svc_domain->svcnum;
+
+my @svc_acct_sm;
+if ($domuser) {
+ @svc_acct_sm=qsearch('svc_acct_sm',{
+ 'domuser' => $domuser,
+ 'domsvc' => $domsvc,
+ });
+} else {
+ @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
+}
+
+if ( scalar(@svc_acct_sm) == 1 ) {
+ my($svcnum)=$svc_acct_sm[0]->svcnum;
+ print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum");
+} elsif ( scalar(@svc_acct_sm) > 1 ) {
+%>
+<!-- mason kludge -->
+<%
+ print header('Mail Alias Search Results'), &table(), <<END;
+ <TR>
+ <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($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!<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 '</TABLE></BODY></HTML>';
+
+} else { #error
+ idiot("Mail Alias not found");
+}
+
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Mail Alias Search</TITLE>
+ </HEAD>
+ <BODY>
+ <CENTER>
+ <H1>Mail Alias Search</H1>
+ </CENTER>
+ <HR>
+ <FORM ACTION="svc_acct_sm.cgi" METHOD="post">
+ Search for <B>mail alias</B>:
+ <INPUT TYPE="text" NAME="domuser"><FONT SIZE=-1>(opt.)</FONT> @
+ <INPUT TYPE="text" NAME="domain"><FONT SIZE=-1>(req.)</FONT>
+
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+
+ <HR>
+
+ </BODY>
+</HTML>
+
--- /dev/null
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($query)=$cgi->keywords;
+$query ||= ''; #to avoid use of unitialized value errors
+my(@svc_domain,$sortby);
+if ( $query eq 'svcnum' ) {
+ $sortby=\*svcnum_sort;
+ @svc_domain=qsearch('svc_domain',{});
+} elsif ( $query eq 'domain' ) {
+ $sortby=\*domain_sort;
+ @svc_domain=qsearch('svc_domain',{});
+} elsif ( $query eq 'UN_svcnum' ) {
+ $sortby=\*svcnum_sort;
+ @svc_domain = grep qsearchs('cust_svc',{
+ 'svcnum' => $_->svcnum,
+ 'pkgnum' => '',
+ }), qsearch('svc_domain',{});
+} elsif ( $query eq 'UN_domain' ) {
+ $sortby=\*domain_sort;
+ @svc_domain = grep qsearchs('cust_svc',{
+ 'svcnum' => $_->svcnum,
+ 'pkgnum' => '',
+ }), qsearch('svc_domain',{});
+} else {
+ $cgi->param('domain') =~ /^([\w\-\.]+)$/;
+ my($domain)=$1;
+ #push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain});
+ @svc_domain = qsearchs('svc_domain',{'domain'=>$domain});
+}
+
+if ( scalar(@svc_domain) == 1 ) {
+ print $cgi->redirect(popurl(2). "view/svc_domain.cgi?". $svc_domain[0]->svcnum);
+ #exit;
+} elsif ( scalar(@svc_domain) == 0 ) {
+%>
+<!-- mason kludge -->
+<%
+ eidiot "No matching domains found!\n";
+} else {
+%>
+<!-- mason kludge -->
+<%
+ my($total)=scalar(@svc_domain);
+ print header("Domain Search Results",''), <<END;
+
+ $total matching domains found
+ <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
+ <TR>
+ <TH>Service #</TH>
+ <TH>Domain</TH>
+ <TH>Mail to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
+ <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
+ </TR>
+END
+
+# my(%saw); # if we've multiple domains with the same
+ # svcnum, then we've a corrupt database
+
+ foreach my $svc_domain (
+# sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain)
+ sort $sortby (@svc_domain)
+ ) {
+ my($svcnum,$domain)=(
+ $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 @svc_acct=qsearch('svc_acct',{'domsvc' => $svcnum});
+ my $rowspan = 0;
+
+ my $n1 = '';
+ my($svc_acct, @rows);
+ foreach $svc_acct (
+ sort {$b->getfield('username') cmp $a->getfield('username')} (@svc_acct)
+ ) {
+
+ my (@forwards) = ();
+
+ my($svcnum,$username)=(
+ $svc_acct->svcnum,
+ $svc_acct->username,
+ );
+
+ my @svc_forward = qsearch( 'svc_forward', { 'srcsvc' => $svcnum } );
+ my $svc_forward;
+ foreach $svc_forward (@svc_forward) {
+ my($dstsvc,$dst) = (
+ $svc_forward->dstsvc,
+ $svc_forward->dst,
+ );
+ if ($dstsvc) {
+ my $dst_svc_acct=qsearchs( 'svc_acct', { 'svcnum' => $dstsvc } );
+ my $destination=$dst_svc_acct->email;
+ push @forwards, qq!<TD><A HREF="!, popurl(2),
+ qq!view/svc_acct.cgi?$dstsvc">$destination</A>!,
+ qq!</TD></TR>!
+ ;
+ }else{
+ push @forwards, qq!<TD>$dst</TD></TR>!
+ ;
+ }
+ }
+
+ push @rows, qq!$n1<TD ROWSPAN=!, (scalar(@svc_forward) || 1),
+ qq!><A HREF="!. popurl(2). qq!view/svc_acct.cgi?$svcnum">!,
+ #print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
+ ( ($username eq '*') ? "<I>(anything)</I>" : $username ),
+ qq!\@$domain</A> </TD>!,
+ ;
+
+ push @rows, @forwards;
+
+ $rowspan += (scalar(@svc_forward) || 1);
+ $n1 = "</TR><TR>";
+ }
+ #end of false laziness
+
+
+
+ print <<END;
+ <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
+
+ print @rows;
+ print "</TR>";
+
+ }
+
+ print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+}
+
+sub svcnum_sort {
+ $a->getfield('svcnum') <=> $b->getfield('svcnum');
+}
+
+sub domain_sort {
+ $a->getfield('domain') cmp $b->getfield('domain');
+}
+
+
+%>
--- /dev/null
+<HTML>
+ <HEAD>
+ <TITLE>Domain Search</TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <FONT SIZE=7>
+ Domain Search
+ </FONT>
+ <BR><BR>
+ <FORM ACTION="svc_domain.cgi" METHOD="post">
+ Search for <B>domain</B>:
+ <INPUT TYPE="text" NAME="domain">
+
+ <P><INPUT TYPE="submit" VALUE="Search">
+
+ </FORM>
+ </BODY>
+</HTML>
+
--- /dev/null
+<!-- mason kludge -->
+<%
+
+#untaint invnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $invnum = $1;
+
+my $cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
+die "Invoice #$invnum not found!" unless $cust_bill;
+my $custnum = $cust_bill->getfield('custnum');
+
+#my $printed = $cust_bill->printed;
+
+print header('Invoice View', menubar(
+ "Main Menu" => $p,
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+));
+
+print qq!<A HREF="${p}edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A> | !
+ if $cust_bill->owed > 0;
+
+print qq!<A HREF="${p}misc/print-invoice.cgi?$invnum">Reprint this invoice</A>!. '<BR><BR>';
+
+#false laziness with search/cust_bill_event.cgi
+
+print table(). '<TR><TH>Event</TH><TH>Date</TH><TH>Status</TH></TR>';
+foreach my $cust_bill_event (
+ sort { $a->_date <=> $b->_date } $cust_bill->cust_bill_event
+) {
+ my $status = $cust_bill_event->status;
+ $status .= ': '. $cust_bill_event->statustext if $cust_bill_event->statustext;
+ print '<TR><TD>'. $cust_bill_event->part_bill_event->event. '</TD><TD>'.
+ time2str("%a %b %e %T %Y", $cust_bill_event->_date). '</TD><TD>'.
+ $status. '</TD></TR>';
+}
+print '</TABLE><BR><PRE>';
+
+print $cust_bill->print_text;
+
+ #formatting
+ print <<END;
+ </PRE></FONT>
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+
+#false laziness with view/cust_pkg.cgi, but i'm trying to make that go away so
+my %uiview = ();
+my %uiadd = ();
+foreach my $part_svc ( qsearch('part_svc',{}) ) {
+ $uiview{$part_svc->svcpart} = popurl(2). "view/". $part_svc->svcdb . ".cgi";
+ $uiadd{$part_svc->svcpart}= popurl(2). "edit/". $part_svc->svcdb . ".cgi";
+}
+
+print header("Customer View", menubar(
+ 'Main Menu' => popurl(2)
+));
+
+die "No customer specified (bad URL)!" unless $cgi->keywords;
+my($query) = $cgi->keywords; # needs parens with my, ->keywords returns array
+$query =~ /^(\d+)$/;
+my $custnum = $1;
+my $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+die "Customer not found!" unless $cust_main;
+
+print qq!<A HREF="!, popurl(2),
+ qq!edit/cust_main.cgi?$custnum">Edit this customer</A>!;
+print qq! | <A HREF="!, popurl(2),
+ qq!misc/delete-customer.cgi?$custnum"> Delete this customer</A>!
+ if $conf->exists('deletecustomers');
+
+unless ( $conf->exists('disable_customer_referrals') ) {
+ print qq! | <A HREF="!, popurl(2),
+ qq!edit/cust_main.cgi?referral_custnum=$custnum">!,
+ qq!Refer a new customer</A>!;
+
+ print qq! | <A HREF="!, popurl(2),
+ qq!search/cust_main.cgi?referral_custnum=$custnum">!,
+ qq!View this customer's referrals</A>!;
+}
+
+print '<BR><BR>';
+
+my $signupurl = $conf->config('signupurl');
+if ( $signupurl ) {
+print "This customer's signup URL: ".
+ "<a href=\"$signupurl?ref=$custnum\">$signupurl?ref=$custnum</a><BR><BR>";
+}
+
+print '<A NAME="cust_main"></A>';
+
+print &itable(), '<TR>';
+
+print '<TD VALIGN="top">';
+
+ print "Billing address", &ntable("#cccccc"), "<TR><TD>",
+ &ntable("#cccccc",2),
+ '<TR><TD ALIGN="right">Contact name</TD>',
+ '<TD COLSPAN=3 BGCOLOR="#ffffff">',
+ $cust_main->last, ', ', $cust_main->first,
+ '</TD>';
+print '<TD ALIGN="right">SS#</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->ss || ' ', '</TD>'
+ if $conf->exists('show_ss');
+
+print '</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>"
+ ;
+
+ if ( defined $cust_main->dbdef_table->column('ship_last') ) {
+
+ my $pre = $cust_main->ship_last ? 'ship_' : '';
+
+ print "<BR>Service address", &ntable("#cccccc"), "<TR><TD>",
+ &ntable("#cccccc",2),
+ '<TR><TD ALIGN="right">Contact name</TD>',
+ '<TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}last"), ', ', $cust_main->get("${pre}first"),
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}company"),
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Address</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}address1"),
+ '</TD></TR>',
+ ;
+ print '<TR><TD ALIGN="right"> </TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}address2"), '</TD></TR>'
+ if $cust_main->get("${pre}address2");
+ print '<TR><TD ALIGN="right">City</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}city"),
+ '</TD><TD ALIGN="right">State</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}state"),
+ '</TD><TD ALIGN="right">Zip</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}zip"), '</TD></TR>',
+ '<TR><TD ALIGN="right">Country</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}country"),
+ '</TD></TR>',
+ ;
+ print '<TR><TD ALIGN="right">Day Phone</TD>',
+ '<TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}daytime") || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Night Phone</TD>'.
+ '<TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}night") || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->get("${pre}fax") || ' ', '</TD></TR>',
+ '</TABLE>', "</TD></TR></TABLE>"
+ ;
+
+ }
+
+print '</TD>';
+
+print '<TD VALIGN="top">';
+
+ print &ntable("#cccccc"), "<TR><TD>", &ntable("#cccccc",2),
+ '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">',
+ $custnum, '</TD></TR>',
+ ;
+
+ my @agents = qsearch( 'agent', {} );
+ my $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>';
+ } else {
+ $agent = $agents[0];
+ }
+ my @referrals = qsearch( 'part_referral', {} );
+ unless ( scalar(@referrals) == 1 ) {
+ my $referral = qsearchs('part_referral', {
+ 'refnum' => $cust_main->refnum
+ } );
+ print '<TR><TD ALIGN="right">Advertising source</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 '<TR><TD ALIGN="right">Referring Customer</TD><TD BGCOLOR="#ffffff">';
+ my $referring_cust_main = '';
+ if ( $cust_main->referral_custnum
+ && ( $referring_cust_main =
+ qsearchs('cust_main', { custnum => $cust_main->referral_custnum } )
+ )
+ ) {
+ print '<A HREF="'. popurl(1). 'cust_main.cgi?'.
+ $cust_main->referral_custnum. '">'.
+ $cust_main->referral_custnum. ': '.
+ ( $referring_cust_main->company
+ ? $referring_cust_main->company. ' ('.
+ $referring_cust_main->last. ', '. $referring_cust_main->first.
+ ')'
+ : $referring_cust_main->last. ', '. $referring_cust_main->first
+ ).
+ '</A>';
+ }
+ print '</TD></TR>';
+
+ print '</TABLE></TD></TR></TABLE>';
+
+print '<BR>';
+
+ my @invoicing_list = $cust_main->invoicing_list;
+ print "Billing information (",
+ qq!<A HREF="!, popurl(2), qq!misc/bill.cgi?$custnum">!, "Bill now</A>)",
+ &ntable("#cccccc"), "<TR><TD>", &ntable("#cccccc",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' ) {
+ my $payinfo = $cust_main->payinfo;
+ $payinfo = substr($payinfo,0,4). 'x'x(length($payinfo)-4);
+
+ print 'Credit card</TD></TR>',
+ '<TR><TD ALIGN="right">Card number</TD><TD BGCOLOR="#ffffff">',
+ $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>',
+ ;
+ }
+
+ print "</TABLE></TD></TR></TABLE>";
+
+print '</TD></TR></TABLE>';
+
+if ( defined $cust_main->dbdef_table->column('comments')
+ && $cust_main->comments )
+{
+ print "<BR>Comments", &ntable("#cccccc"), "<TR><TD>",
+ &ntable("#cccccc",2),
+ '<TR><TD BGCOLOR="#ffffff"><PRE>', $cust_main->comments,
+ '</PRE></TD></TR></TABLE></TABLE>';
+}
+
+print '</TD></TR></TABLE>';
+
+print '<BR>'.
+ '<FORM ACTION="'.popurl(2).'edit/process/quick-cust_pkg.cgi" METHOD="POST">'.
+ qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!.
+ '<SELECT NAME="pkgpart"><OPTION> ';
+
+foreach my $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ my $pkgpart = $type_pkgs->pkgpart;
+# my $part_pkg = qsearchs('part_pkg', { 'pkgpart' => $pkgpart } )
+# or do { warn "unknown type_pkgs.pkgpart $pkgpart"; next; };
+ my $part_pkg =
+ qsearchs('part_pkg', { 'pkgpart' => $pkgpart, 'disabled' => '' } )
+ or next;
+ print qq!<OPTION VALUE="$pkgpart">!. $part_pkg->pkg. ' - '.
+ $part_pkg->comment;
+}
+
+print '</SELECT><INPUT TYPE="submit" VALUE="Order Package"><BR>';
+
+print <<END;
+<SCRIPT>
+function cust_pkg_areyousure(href) {
+ if (confirm("Permanantly delete included services and cancel this package?") == true)
+ window.location.href = href;
+}
+</SCRIPT>
+END
+
+print qq!<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> (preserves services) )!,
+;
+
+#display packages
+
+#formatting
+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!,
+ qq!</FONT></TH>!,
+ qq!<TH><FONT SIZE=-1>Cancel</FONT></TH>!,
+ qq!</TR>\n!;
+
+#get package info
+my @packages;
+if ( $conf->exists('hidecancelledpackages') ) {
+ @packages = sort { $a->pkgnum <=> $b->pkgnum } ($cust_main->ncancelled_pkgs);
+} else {
+ @packages = sort { $a->pkgnum <=> $b->pkgnum } ($cust_main->all_pkgs);
+}
+
+my $n1 = '<TR>';
+foreach my $package (@packages) {
+ 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 @cust_svc = ();
+ my $rowspan = 0;
+ my %pkg_svc = ();
+ unless ( $package->getfield('cancel') ) {
+ foreach my $pkg_svc (
+ grep { $_->quantity }
+ qsearch('pkg_svc',{'pkgpart'=> $package->pkgpart })
+ ) {
+ $rowspan += ( $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity );
+ }
+ } else {
+ #@cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } );
+ @cust_svc = ();
+ $rowspan = scalar(@cust_svc) || 1;
+ }
+ $rowspan ||= 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 ( <a href="$pkgview">Details</a> )!;
+ # | !;
+
+ #false laziness with view/cust_pkg.cgi, but i'm trying to make that go away so
+ unless ( $package->getfield('cancel') ) {
+ print ' ( ';
+ if ( $package->getfield('susp') ) {
+ print qq!<A HREF="${p}misc/unsusp_pkg.cgi?$pkgnum">Unsuspend</A>!;
+ } else {
+ print qq!<A HREF="${p}misc/susp_pkg.cgi?$pkgnum">Suspend</A>!;
+ }
+ print ' | <A HREF="javascript:cust_pkg_areyousure(\''. popurl(2).
+ 'misc/cancel_pkg.cgi?'. $pkgnum. '\')">Cancel</A>';
+
+ print ' ) ';
+
+ print ' ( <A HREF="'. popurl(2). 'edit/REAL_cust_pkg.cgi?'. $pkgnum.
+ '">Edit dates</A> | ';
+
+ print qq!<A HREF="$button_url">Customize</A> )!;
+
+ }
+ print '</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 = '';
+ #false laziness with view/cust_pkg.cgi, but i'm trying to make that go away so
+ #foreach my $cust_svc ( @cust_svc ) {
+ foreach my $svcpart ( sort { $a<=>$b } keys %pkg_svc ) {
+ my $svc = qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
+ my(@cust_svc)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
+ 'svcpart'=>$svcpart,
+ });
+ for my $enum ( 1 .. $pkg_svc{$svcpart} ) {
+ my $cust_svc;
+ if ( $cust_svc = shift @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>!;
+ } else {
+ print $n2, qq!<TD COLSPAN=2><A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart"><b><font size="+1" color="#ff0000">!.
+ qq!Provision $svc</A></b></font>!;
+
+ print qq!<BR><A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">!.
+ qq!<b><font size="+1" color="#ff0000">Link to legacy $svc</A></b></font>!
+ if $conf->exists('legacy_link');
+
+ print '</TD>';
+ }
+ $n2="</TR><TR>";
+ }
+ }
+
+ $n1="</TR><TR>";
+}
+print "</TR>";
+
+#formatting
+print "</TABLE>";
+
+print <<END;
+<SCRIPT>
+function cust_pay_areyousure(href) {
+ if (confirm("Are you sure you want to delete this payment?")
+ == true)
+ window.location.href = href;
+}
+</SCRIPT>
+END
+
+#formatting
+print qq!<BR><BR><A NAME="history">Payment History!.
+ qq!</A> ( !.
+ qq!<A HREF="!. popurl(2). qq!edit/cust_pay.cgi?custnum=$custnum">!.
+ qq!Post payment</A> | !.
+ qq!<A HREF="!. popurl(2). qq!edit/cust_credit.cgi?$custnum">!.
+ qq!Post credit</A> )!;
+
+#get payment history
+#
+# major problem: this whole thing is way too sloppy.
+# minor problem: the description lines need better formatting.
+
+my @history = (); #needed for mod_perl :)
+
+my %target = ();
+
+my @bills = qsearch('cust_bill',{'custnum'=>$custnum});
+foreach my $bill (@bills) {
+ my($bref)=$bill->hashref;
+ my $bpre = ( $bill->owed > 0 )
+ ? '<b><font size="+1" color="#ff0000"> Open '
+ : '';
+ my $bpost = ( $bill->owed > 0 ) ? '</font></b>' : '';
+ push @history,
+ $bref->{_date} . qq!\t<A HREF="!. popurl(2). qq!view/cust_bill.cgi?! .
+ $bref->{invnum} . qq!">${bpre}Invoice #! . $bref->{invnum} .
+ qq! (Balance \$! . $bill->owed . qq!)$bpost</A>\t! .
+ $bref->{charged} . qq!\t\t\t!;
+
+ my(@cust_bill_pay)=qsearch('cust_bill_pay',{'invnum'=> $bref->{invnum} } );
+# my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } );
+# my($payment);
+# foreach $payment (@payments) {
+ foreach my $cust_bill_pay (@cust_bill_pay) {
+ my $payment = $cust_bill_pay->cust_pay;
+ my($date,$invnum,$payby,$payinfo,$paid)=($payment->_date,
+ $cust_bill_pay->invnum,
+ $payment->payby,
+ $payment->payinfo,
+ $cust_bill_pay->amount,
+ );
+ $payinfo = substr($payinfo,0,4). 'x'x(length($payinfo)-4)
+ if $payby eq 'CARD';
+ my $target = "$payby$payinfo";
+ $payby =~ s/^BILL$/Check #/ if $payinfo;
+ $payby =~ s/^(CARD|COMP)$/$1 /;
+ my $delete = $payment->closed !~ /^Y/i && $conf->exists('deletepayments')
+ ? qq! (<A HREF="javascript:cust_pay_areyousure('${p}misc/delete-cust_pay.cgi?!. $payment->paynum. qq!')">delete</A>)!
+ : '';
+ push @history,
+ "$date\tPayment, Invoice #$invnum ($payby$payinfo)$delete\t\t$paid\t\t\t$target";
+ }
+
+ my(@cust_credit_bill)=
+ qsearch('cust_credit_bill', { 'invnum'=> $bref->{invnum} } );
+ foreach my $cust_credit_bill (@cust_credit_bill) {
+ my $cust_credit = $cust_credit_bill->cust_credit;
+ my($date, $invnum, $crednum, $amount, $reason, $app_date ) = (
+ $cust_credit->_date,
+ $cust_credit_bill->invnum,
+ $cust_credit_bill->crednum,
+ $cust_credit_bill->amount,
+ $cust_credit->reason,
+ time2str("%D", $cust_credit_bill->_date),
+ );
+ push @history,
+ "$date\tCredit #$crednum: $reason<BR>".
+ "(applied to invoice #$invnum on $app_date)\t\t\t$amount\t";
+ }
+}
+
+my @credits = grep { scalar(my @array = $_->cust_credit_refund) }
+ qsearch('cust_credit',{'custnum'=>$custnum});
+foreach my $credit (@credits) {
+ my($cref)=$credit->hashref;
+ my(@cust_credit_refund)=
+ qsearch('cust_credit_refund', { 'crednum'=> $cref->{crednum} } );
+ foreach my $cust_credit_refund (@cust_credit_refund) {
+ my $cust_refund = $cust_credit_refund->cust_credit;
+ my($date, $crednum, $amount, $reason, $app_date ) = (
+ $credit->_date,
+ $credit->crednum,
+ $cust_credit_refund->amount,
+ $credit->reason,
+ time2str("%D", $cust_credit_refund->_date),
+ );
+ push @history,
+ "$date\tCredit #$crednum: $reason<BR>".
+ "(applied to refund on $app_date)\t\t\t$amount\t";
+ }
+}
+
+@credits = grep { $_->credited > 0 }
+ qsearch('cust_credit',{'custnum'=>$custnum});
+foreach my $credit (@credits) {
+ my($cref)=$credit->hashref;
+ push @history,
+ $cref->{_date} . "\t" .
+ qq!<A HREF="! . popurl(2). qq!edit/cust_credit_bill.cgi?!. $cref->{crednum} . qq!">!.
+ '<b><font size="+1" color="#ff0000">Unapplied credit #' .
+ $cref->{crednum} . "</font></b></A>: ".
+ $cref->{reason} . "\t\t\t" . $credit->credited . "\t";
+}
+
+my(@refunds)=qsearch('cust_refund',{'custnum'=> $custnum } );
+foreach my $refund (@refunds) {
+ my($rref)=$refund->hashref;
+ my($refundnum) = (
+ $refund->refundnum,
+ );
+
+ push @history,
+ $rref->{_date} . "\tRefund #$refundnum, (" .
+ $rref->{payby} . " " . $rref->{payinfo} . ") by " .
+ $rref->{otaker} . " - ". $rref->{reason} . "\t\t\t\t" .
+ $rref->{refund};
+}
+
+my @unapplied_payments =
+ grep { $_->unapplied > 0 } qsearch('cust_pay', { 'custnum' => $custnum } );
+foreach my $payment (@unapplied_payments) {
+ my $payby = $payment->payby;
+ my $payinfo = $payment->payinfo;
+ #false laziness w/above
+ $payinfo = substr($payinfo,0,4). 'x'x(length($payinfo)-4)
+ if $payby eq 'CARD';
+ my $target = "$payby$payinfo";
+ $payby =~ s/^BILL$/Check #/ if $payinfo;
+ $payby =~ s/^(CARD|COMP)$/$1 /;
+ my $delete = $payment->closed !~ /^Y/i && $conf->exists('deletepayments')
+ ? qq! (<A HREF="javascript:cust_pay_areyousure('${p}misc/delete-cust_pay.cgi?!. $payment->paynum. qq!')">delete</A>)!
+ : '';
+ push @history,
+ $payment->_date. "\t".
+ '<b><font size="+1" color="#ff0000">Unapplied payment #' .
+ $payment->paynum . " ($payby$payinfo)</font></b> ".
+ '(<A HREF="'. popurl(2). 'edit/cust_bill_pay.cgi?'. $payment->paynum. '">'.
+ "apply</A>)$delete".
+ "\t\t" . $payment->unapplied . "\t\t\t$target";
+}
+
+ #formatting
+ print &table(), <<END;
+<TR>
+ <TH>Date</TH>
+ <TH>Description</TH>
+ <TH><FONT SIZE=-1>Charge</FONT></TH>
+ <TH><FONT SIZE=-1>Payment</FONT></TH>
+ <TH><FONT SIZE=-1>In-house<BR>Credit</FONT></TH>
+ <TH><FONT SIZE=-1>Refund</FONT></TH>
+ <TH><FONT SIZE=-1>Balance</FONT></TH>
+</TR>
+END
+
+#display payment history
+
+my $balance = 0;
+foreach my $item (sort keyfield_numerically @history) {
+ my($date,$desc,$charge,$payment,$credit,$refund,$target)=split(/\t/,$item);
+ $charge ||= 0;
+ $payment ||= 0;
+ $credit ||= 0;
+ $refund ||= 0;
+ $balance += $charge - $payment;
+ $balance -= $credit - $refund;
+ $balance = sprintf("%.2f", $balance);
+ $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
+ $target = '' unless defined $target;
+
+ print "<TR><TD><FONT SIZE=-1>";
+ print qq!<A NAME="$target">! unless $target && $target{$target}++;
+ print time2str("%D",$date);
+ print '</A>' if $target && $target{$target} == 1;
+ print "</FONT></TD>",
+ "<TD><FONT SIZE=-1>$desc</FONT></TD>",
+ "<TD><FONT SIZE=-1>",
+ ( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
+ "</FONT></TD>",
+ "<TD><FONT SIZE=-1>",
+ ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
+ "</FONT></TD>",
+ "<TD><FONT SIZE=-1>",
+ ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
+ "</FONT></TD>",
+ "<TD><FONT SIZE=-1>",
+ ( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
+ "</FONT></TD>",
+ "<TD><FONT SIZE=-1>\$" . $balance,
+ "</FONT></TD>",
+ "\n";
+}
+
+#formatting
+print "</TABLE>";
+
+#end
+
+#formatting
+print <<END;
+
+ </BODY>
+</HTML>
+END
+
+#subroutiens
+sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0] ; }
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+
+my %uiview = ();
+my %uiadd = ();
+foreach my $part_svc ( qsearch('part_svc',{}) ) {
+ $uiview{$part_svc->svcpart} = popurl(2). "view/". $part_svc->svcdb . ".cgi";
+ $uiadd{$part_svc->svcpart}= popurl(2). "edit/". $part_svc->svcdb . ".cgi";
+}
+
+my ($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $pkgnum = $1;
+
+#get package record
+my $cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+die "No package!" unless $cust_pkg;
+my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
+
+my $custnum = $cust_pkg->getfield('custnum');
+print 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)=(
+ $cust_pkg->getfield('susp'),
+ $cust_pkg->getfield('cancel'),
+ $cust_pkg->getfield('expire'),
+);
+my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
+my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
+my $otaker = $cust_pkg->getfield('otaker');
+
+print <<END;
+<SCRIPT>
+function areyousure(href) {
+ if (confirm("Permanantly delete included services and cancel this package?") == true)
+ window.location.href = href;
+}
+</SCRIPT>
+END
+
+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="javascript:areyousure(\''. popurl(2). 'misc/cancel_pkg.cgi?'.
+ $pkgnum. '\')">cancel</A>)'
+ unless $cancel;
+
+print ' (<A HREF="'. popurl(2). 'edit/REAL_cust_pkg.cgi?'. $pkgnum.
+ '">edit dates</A>)';
+
+print &ntable("#cccccc"), '<TR><TD>', &ntable("#cccccc",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 '<BR>Service Information', &table();
+
+ #list of services this pkgpart includes
+ 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;
+ foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) {
+
+ my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
+
+ my(@cust_svc)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
+ 'svcpart'=>$svcpart,
+ });
+
+ my($enum);
+ for $enum ( 1 .. $pkg_svc{$svcpart} ) {
+
+ 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/Edit) $svc: $value<A></TD></TR>
+END
+ } else {
+ print qq!<TR><TD>!.
+ qq!<A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart">!.
+ qq!(Provision) $svc</A>!;
+
+ print qq! or <A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">!.
+ qq!(Link to legacy) $svc</A>!
+ if $conf->exists('legacy_link');
+
+ print '</TD></TR>';
+ }
+
+ }
+ warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;;
+ }
+
+ print "</TABLE><FONT SIZE=-1>",
+ "Choose (View/Edit) to view or edit an existing service<BR>",
+ "Choose (Provision) to setup a new service<BR>";
+
+ print "Choose (Link to legacy) to link to a legacy (pre-Freeside) service"
+ if $conf->exists('legacy_link');
+
+ print "</FONT>";
+}
+
+#formatting
+print <<END;
+ </BODY>
+</HTML>
+END
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_acct;
+
+#false laziness w/all svc_*.cgi
+my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } );
+my $pkgnum = $cust_svc->getfield('pkgnum');
+my($cust_pkg, $custnum);
+if ($pkgnum) {
+ $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $pkgnum } );
+ $custnum = $cust_pkg->custnum;
+} else {
+ $cust_pkg = '';
+ $custnum = '';
+}
+#eofalse
+
+my $part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
+die "Unknown svcpart" unless $part_svc;
+
+my $domain;
+if ( $svc_acct->domsvc ) {
+ my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $svc_acct->domsvc } );
+ die "Unknown domain" unless $svc_domain;
+ $domain = $svc_domain->domain;
+} else {
+ unless ( $mydomain ) {
+ die "No legacy domain config file and no svc_domain.svcnum record ".
+ "for svc_acct.domsvc: ". $cust_svc->domsvc;
+ }
+ $domain = $mydomain;
+}
+
+print 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,
+));
+
+#print qq!<BR><A HREF="../misc/sendconfig.cgi?$svcnum">Send account information</A>!;
+
+print qq!<A HREF="${p}edit/svc_acct.cgi?$svcnum">Edit this information</A><BR>!.
+ &ntable("#cccccc"). '<TR><TD>'. &ntable("#cccccc",2).
+ "<TR><TD ALIGN=\"right\">Service number</TD>".
+ "<TD BGCOLOR=\"#ffffff\">$svcnum</TD></TR>".
+ "<TR><TD ALIGN=\"right\">Service</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $part_svc->svc. "</TD></TR>".
+ "<TR><TD ALIGN=\"right\">Username</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->username. "</TD></TR>"
+;
+
+print "<TR><TD ALIGN=\"right\">Domain</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $domain, "</TD></TR>";
+
+print "<TR><TD ALIGN=\"right\">Password</TD><TD BGCOLOR=\"#ffffff\">";
+my $password = $svc_acct->_password;
+if ( $password =~ /^\*\w+\* (.*)$/ ) {
+ $password = $1;
+ print "<I>(login disabled)</I> ";
+}
+if ( $conf->exists('showpasswords') ) {
+ print "$password";
+} else {
+ print "<I>(hidden)</I>";
+}
+print "</TR></TD>";
+$password = '';
+
+if ( $conf->exists('security_phrase') ) {
+ my $sec_phrase = $svc_acct->sec_phrase;
+ print '<TR><TD ALIGN="right">Security phrase</TD><TD BGCOLOR="#ffffff">'.
+ $svc_acct->sec_phrase. '</TD></TR>';
+}
+
+my $svc_acct_pop = qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum});
+print "<TR><TD ALIGN=\"right\">Access number</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct_pop->text. '</TD></TR>'
+ if $svc_acct_pop;
+
+if ($svc_acct->uid ne '') {
+ print "<TR><TD ALIGN=\"right\">Uid</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->uid. "</TD></TR>",
+ "<TR><TD ALIGN=\"right\">Gid</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->gid. "</TD></TR>",
+ "<TR><TD ALIGN=\"right\">GECOS</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->finger. "</TD></TR>",
+ "<TR><TD ALIGN=\"right\">Home directory</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->dir. "</TD></TR>",
+ "<TR><TD ALIGN=\"right\">Shell</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->shell. "</TD></TR>",
+ "<TR><TD ALIGN=\"right\">Quota</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->quota. "</TD></TR>"
+ ;
+} else {
+ print "<TR><TH COLSPAN=2>(No shell account)</TH></TR>";
+}
+
+if ($svc_acct->slipip) {
+ print "<TR><TD ALIGN=\"right\">IP address</TD><TD BGCOLOR=\"#ffffff\">".
+ ( ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' )
+ ? "<I>(Dynamic)</I>"
+ : $svc_acct->slipip
+ ). "</TD>";
+ my($attribute);
+ foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
+ #warn $attribute;
+ $attribute =~ /^radius_(.*)$/;
+ my $pattribute = $FS::raddb::attrib{$1};
+ print "<TR><TD ALIGN=\"right\">Radius (reply) $pattribute</TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->getfield($attribute).
+ "</TD></TR>";
+ }
+ foreach $attribute ( grep /^rc_/, fields('svc_acct') ) {
+ #warn $attribute;
+ $attribute =~ /^rc_(.*)$/;
+ my $pattribute = $FS::raddb::attrib{$1};
+ print "<TR><TD ALIGN=\"right\">Radius (check) $pattribute: </TD>".
+ "<TD BGCOLOR=\"#ffffff\">". $svc_acct->getfield($attribute).
+ "</TD></TR>";
+ }
+} else {
+ print "<TR><TH COLSPAN=2>(No SLIP/PPP account)</TH></TR>";
+}
+
+print '<TR><TD ALIGN="right">RADIUS groups</TD><TD BGCOLOR="#ffffff">'.
+ join('<BR>', $svc_acct->radius_groups). '</TD></TR>';
+
+print "</TABLE></TD></TR></TABLE>".
+ '<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
+ "</BODY></HTML>";
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+my $mydomain = $conf->config('domain');
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+my $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);
+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 } )
+ or die "Unkonwn svcpart";
+
+print 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,
+));
+
+my($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})
+ or die "Corrupted database: no svc_domain.svcnum matching domsvc $domsvc";
+my $domain = $svc_domain->domain;
+my $svc_acct = qsearchs('svc_acct',{'uid'=>$domuid})
+ or die "Corrupted database: no svc_acct.uid matching domuid $domuid";
+my $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>'
+;
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+my $svc_domain = qsearchs('svc_domain',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_domain;
+
+my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+my $pkgnum = $cust_svc->getfield('pkgnum');
+my($cust_pkg, $custnum);
+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 } );
+die "Unknown svcpart" unless $part_svc;
+
+my $email = '';
+if ($svc_domain->catchall) {
+ my $svc_acct = qsearchs('svc_acct',{'svcnum'=> $svc_domain->catchall } );
+ die "Unknown svcpart" unless $svc_acct;
+ $email = $svc_acct->email;
+}
+
+my $domain = $svc_domain->domain;
+
+print 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>Catch all email <A HREF="${p}misc/catchall.cgi?$svcnum">(change)</A>:!,
+ $email ? "<B>$email</B>." : "<I>(none)<I>",
+ qq!<BR><BR><A HREF="http://www.geektools.com/cgi-bin/proxy.cgi?query=$domain;targetnic=auto">View whois information.</A>!,
+ '<BR><BR>', ntable("",2),
+ '<tr><th>Zone</th><th>Type</th><th>Data</th></tr>',
+;
+
+foreach my $domain_record ( qsearch('domain_record', { svcnum => $svcnum } ) ) {
+ print '<tr><td>'. $domain_record->reczone. '</td>'.
+ '<td>'. $domain_record->recaf. ' '. $domain_record->rectype. '</td>'.
+ '<td>'. $domain_record->recdata. '</td></tr>';
+}
+print '</table>'.
+ '<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
+ '</BODY></HTML>';
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my $conf = new FS::Conf;
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+my $svc_forward = qsearchs('svc_forward',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_forward;
+
+my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+my $pkgnum = $cust_svc->getfield('pkgnum');
+my($cust_pkg, $custnum);
+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 } )
+ or die "Unkonwn svcpart";
+
+print header('Mail Forward 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,
+));
+
+my($srcsvc,$dstsvc,$dst) = (
+ $svc_forward->srcsvc,
+ $svc_forward->dstsvc,
+ $svc_forward->dst,
+);
+my $svc = $part_svc->svc;
+my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$srcsvc})
+ or die "Corrupted database: no svc_acct.svcnum matching srcsvc $srcsvc";
+my $source = $svc_acct->email;
+my $destination;
+if ($dstsvc) {
+ my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$dstsvc})
+ or die "Corrupted database: no svc_acct.svcnum matching dstsvc $dstsvc";
+ $destination = $svc_acct->email;
+}else{
+ $destination = $dst;
+}
+
+print qq!<A HREF="${p}edit/svc_forward.cgi?$svcnum">Edit this information</A>!.
+ "<BR>Service #$svcnum".
+ "<BR>Service: <B>$svc</B>".
+ qq!<BR>Mail to <B>$source</B> forwards to <B>$destination</B> mailbox.!.
+ '<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
+ '</BODY></HTML>'
+;
+
+%>
--- /dev/null
+<!-- mason kludge -->
+<%
+
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+my $svcnum = $1;
+my $svc_www = qsearchs( 'svc_www', { 'svcnum' => $svcnum } )
+ or die "svc_www: Unknown svcnum $svcnum";
+
+#false laziness w/all svc_*.cgi
+my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $svcnum } );
+my $pkgnum = $cust_svc->getfield('pkgnum');
+my($cust_pkg, $custnum);
+if ($pkgnum) {
+ $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $pkgnum } );
+ $custnum = $cust_pkg->custnum;
+} else {
+ $cust_pkg = '';
+ $custnum = '';
+}
+#eofalse
+
+my $domain_record = qsearchs('domain_record', { 'recnum' => $svc_www->recnum } )
+ or die "svc_www: Unknown recnum". $svc_www->recnum;
+
+my $www = $domain_record->reczone;
+unless ( $www =~ /\.$/ ) {
+ my $svc_domain = qsearchs('svc_domain', { svcnum=>$domain_record->svcnum } );
+ $www .= '.'. $svc_domain->domain;
+}
+
+print header('Website View', menubar(
+ ( ( $custnum )
+ ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ )
+ : ( "Cancel this (unaudited) website" =>
+ "${p}misc/cancel-unaudited.cgi?$svcnum" )
+ ),
+ "Main menu" => $p,
+)).
+ "Service #$svcnum".
+ qq!<BR>Website name: <B><A HREF="http://$www">$www</A></B>!.
+ '<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
+ '</BODY></HTML>'
+;
+%>
--- /dev/null
+#! /bin/sh
+#
+# chkconfig: 345 86 16
+# description: Freeside daemons
+
+QUEUED_USER=ivan
+
+FREESIDE_PATH="/home/ivan/freeside_current"
+
+PASSWD_USER=ivan
+PASSWD_MACHINE=localhost
+
+SIGNUP_USER=ivan
+SIGNUP_MACHINE=localhost
+SIGNUP_AGENTNUM=2
+SIGNUP_REFNUM=2
+
+case "$1" in
+ start)
+ # Start daemons.
+ echo -n "Starting freeside-queued: "
+ freeside-queued $QUEUED_USER
+ echo "done."
+
+ echo -n "Starting fs_passwd_server: "
+ su freeside -c "$FREESIDE_PATH/fs_passwd/fs_passwd_server $PASSWD_USER $PASSWD_MACHINE" &
+ echo "done."
+
+ echo -n "Starting fs_signup_server: "
+ su freeside -c "$FREESIDE_PATH/fs_signup/fs_signup_server $SIGNUP_USER $SIGNUP_MACHINE $SIGNUP_AGENTNUM $SIGNUP_REFNUM" &
+ echo "done."
+ ;;
+ stop)
+ # Stop daemons.
+ echo -n "Stopping freeside-queued: "
+ kill `cat /var/run/freeside-queued.pid`
+ echo "done."
+
+ echo -n "Stopping fs_passwd_server: "
+ killall fs_passwd_server
+ echo "done."
+
+ echo -n "Stopping fs_signup_server: "
+ killall fs_signup_server
+ echo "done."
+ ;;
+
+ restart)
+ $0 stop
+ $0 start
+ ;;
+ *)
+ echo "Usage: freeside {start|stop|restart}"
+ exit 1
+esac
+
+exit 0
+
+++ /dev/null
-package FS::Bill;
-
-use strict;
-use vars qw(@ISA);
-use FS::cust_main;
-
-@ISA = qw(FS::cust_main);
-
-warn "FS::Bill depriciated\n";
-
-=head1 NAME
-
-FS::Bill - Legacy stub
-
-=head1 SYNOPSIS
-
-The functionality of FS::Bill has been integrated into FS::cust_main.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-24 - 25 - 28
-
-use Safe; evaluate all fees with perl (still on TODO list until I write
-some examples & test opmask to see if we can read db)
-%hash=$obj->hash later ivan@sisd.com 98-mar-13
-
-packages with no next bill date start at $time not time, this should
-eliminate the last of the problems with billing at a past date
-also rewrite the invoice priting logic not to print invoices for things
-that haven't happended yet and update $cust_bill->printed when we print
-so PAST DUE notices work, and s/date/_date/
-ivan@sisd.com 98-jun-4
-
-more logic for past due stuff - packages with no next bill date start
-at $cust_pkg->setup || $time ivan@sisd.com 98-jul-13
-
-moved a few things in collection logic; negative charges should work
-ivan@sisd.com 98-aug-6
-
-pod, moved everything to FS::cust_main ivan@sisd.com 98-sep-19
-
-=cut
-
-1;
+++ /dev/null
-package FS::CGI;
-
-use strict;
-use vars qw(@EXPORT_OK @ISA);
-use Exporter;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(header menubar idiot eidiot);
-
-=head1 NAME
-
-FS::CGI - Subroutines for the web interface
-
-=head1 SYNOPSIS
-
- use FS::CGI qw(header menubar idiot eidiot);
-
- print header( 'Title', '' );
- print header( 'Title', menubar('item', 'URL', ... ) );
-
- idiot "error message";
- eidiot "error message";
-
-=head1 DESCRIPTION
-
-Provides a few common subroutines for the web interface.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item header TITLE, MENUBAR
-
-Returns an HTML header.
-
-=cut
-
-sub header {
- my($title,$menubar)=@_;
-
- <<END;
- <HTML>
- <HEAD>
- <TITLE>
- $title
- </TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>
- $title
- </H1>
- $menubar
- </CENTER>
- <HR>
-END
-}
-
-=item menubar ITEM, URL, ...
-
-Returns an HTML menubar.
-
-=cut
-
-sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... );
- my($item,$url,@html);
- while (@_) {
- ($item,$url)=splice(@_,0,2);
- push @html, qq!<A HREF="$url">$item</A>!;
- }
- join(' | ',@html);
-}
-
-=item idiot ERROR
-
-Sends headers and an HTML error message.
-
-=cut
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error processing your request</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error processing your request</H4>
- </CENTER>
- Your request could not be processed because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and try again.
- </BODY>
-</HTML>
-END
-
-}
-
-=item eidiot ERROR
-
-Sends headers and an HTML error message, then exits.
-
-=cut
-
-sub eidiot {
- idiot(@_);
- exit;
-}
-
-=back
-
-=head1 BUGS
-
-Not OO.
-
-Not complete.
-
-Uses CGI-modules instead of CGI.pm
-
-=head1 SEE ALSO
-
-L<CGI::Base>
-
-=head1 HISTORY
-
-subroutines for the HTML/CGI GUI, not properly OO. :(
-
-ivan@sisd.com 98-apr-16
-ivan@sisd.com 98-jun-22
-
-lose the background, eidiot ivan@sisd.com 98-sep-2
-
-pod ivan@sisd.com 98-sep-12
-
-=cut
-
-1;
-
-
+++ /dev/null
-package FS::Conf;
-
-use vars qw($default_dir);
-use IO::File;
-
-$default_dir='/var/spool/freeside/conf';
-
-=head1 NAME
-
-FS::Conf - Read access to Freeside configuration values
-
-=head1 SYNOPSIS
-
- use FS::Conf;
-
- $conf = new FS::Conf;
- $conf = new FS::Conf "/non/standard/config/directory";
-
- $dir = $conf->dir;
-
- $value = $conf->config('key');
- @list = $conf->config('key');
- $bool = $conf->exists('key');
-
-=head1 DESCRIPTION
-
-Read access to Freeside configuration values. Keys currently map to filenames,
-but this may change in the future.
-
-=head1 METHODS
-
-=over 4
-
-=item new [ DIRECTORY ]
-
-Create a new configuration object. Optionally, a non-default directory may
-be specified.
-
-=cut
-
-sub new {
- my($proto,$dir) = @_;
- my($class) = ref($proto) || $proto;
- my($self) = { 'dir' => $dir || $default_dir } ;
- bless ($self, $class);
-}
-
-=item dir
-
-Returns the directory.
-
-=cut
-
-sub dir {
- my($self) = @_;
- $self->{dir};
-}
-
-=item config
-
-Returns the configuration value or values (depending on context) for key.
-
-=cut
-
-sub config {
- my($self,$file)=@_;
- my($dir)=$self->dir;
- my $fh = new IO::File "<$dir/$file" or return;
- if ( wantarray ) {
- map {
- /^(.*)$/ or die "Illegal line in $dir/$file:\n$_\n";
- $1;
- } <$fh>;
- } else {
- <$fh> =~ /^(.*)$/ or die "Illegal line in $dir/$file:\n$_\n";
- $1;
- }
-}
-
-=item exists
-
-Returns true if the specified key exists, even if the corresponding value
-is undefined.
-
-=cut
-
-sub exists {
- my($self,$file)=@_;
- my($dir) = $self->dir;
- -e "$dir/$file";
-}
-
-=back
-
-=head1 BUGS
-
-The option to specify a non-default directory should probably be removed.
-
-Write access (with locking) should be implemented.
-
-=head1 SEE ALSO
-
-config.html from the base documentation contains a list of configuration files.
-
-=head1 HISTORY
-
-Ivan Kohler <ivan@sisd.com> 98-sep-6
-
-sub exists forgot to fetch $dir ivan@sisd.com 98-sep-27
-
-=cut
-
-1;
+++ /dev/null
-package FS::Invoice;
-
-use strict;
-use vars qw(@ISA);
-use FS::cust_bill;
-
-@ISA = qw(FS::cust_bill);
-
-#warn "FS::Invoice depriciated\n";
-
-=head1 NAME
-
-FS::Invoice - Legacy stub
-
-=head1 SYNOPSIS
-
-The functioanlity of FS::invoice has been integrated in FS::cust_bill.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jun-25 - 27
-
-maybe should be changed to be OO-functions on $cust_bill objects?
-(instead of passing invnum, ugh).
-
-ISA cust_bill and return inovice instead of passing filehandle
-ivan@sisd.com 98-mar-13
-
-(add postscript output!)
-
-close our kid when we're done ivan@sisd.com 98-jun-4
-
-separated code which shuffled data from code which formatted.
-(so i could) fixed past due notices showing up when balance due =< 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
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::Record;
-
-use strict;
-use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK);
-use subs qw(reload_dbdef);
-use Exporter;
-use Carp;
-use File::CounterFile;
-use FS::UID qw(dbh checkruid swapuid getotaker datasrc);
-use FS::dbdef;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
-
-$File::CounterFile::DEFAULT_DIR = "/var/spool/freeside/counters" ;
-
-$dbdef_file = "/var/spool/freeside/dbdef.". datasrc;
-
-reload_dbdef unless $setup_hack;
-
-=head1 NAME
-
-FS::Record - Database record objects
-
-=head1 SYNOPSIS
-
- use FS::Record;
- use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
-
- $record = new FS::Record 'table', \%hash;
- $record = new FS::Record 'table', { 'column' => 'value', ... };
-
- $record = qsearchs FS::Record 'table', \%hash;
- $record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
- @records = qsearch FS::Record 'table', \%hash;
- @records = qsearch FS::Record 'table', { 'column' => 'value', ... };
-
- $table = $record->table;
- $dbdef_table = $record->dbdef_table;
-
- $value = $record->get('column');
- $value = $record->getfield('column');
- $value = $record->column;
-
- $record->set( 'column' => 'value' );
- $record->setfield( 'column' => 'value' );
- $record->column('value');
-
- %hash = $record->hash;
-
- $hashref = $record->hashref;
-
- $error = $record->add;
-
- $error = $record->del;
-
- $error = $new_record->rep($old_record);
-
- $value = $record->unique('column');
-
- $value = $record->ut_float('column');
- $value = $record->ut_number('column');
- $value = $record->ut_numbern('column');
- $value = $record->ut_money('column');
- $value = $record->ut_text('column');
- $value = $record->ut_textn('column');
- $value = $record->ut_alpha('column');
- $value = $record->ut_alphan('column');
- $value = $record->ut_phonen('column');
- $value = $record->ut_anythingn('column');
-
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
-
- $quoted_value = _quote($value,'table','field');
-
- #depriciated
- $fields = hfields('table');
- if ( $fields->{Field} ) { # etc.
-
- @fields = fields 'table';
-
-
-=head1 DESCRIPTION
-
-(Mostly) object-oriented interface to database records. Records are currently
-implemented on top of DBI. FS::Record is intended as a base class for
-table-specific classes to inherit from, i.e. FS::cust_main.
-
-=head1 METHODS
-
-=over 4
-
-=item new TABLE, HASHREF
-
-Creates a new record. It doesn't store it in the database, though. See
-L<"add"> 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 I<hash>
-method.
-
-=cut
-
-sub new {
- my($proto,$table,$hashref) = @_;
- confess "Second arguement to FS::Record->new is not a HASH ref: ",
- ref($hashref), " ", $hashref, "\n"
- unless ref($hashref) eq 'HASH'; #bad practice?
-
- #check to make sure $table exists? (ask dbdef)
-
- foreach my $field ( FS::Record::fields $table ) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- # mySQL must rtrim the inbound text strings or store them z-terminated
- # I simulate this for Postgres below
- # Turned off in favor of ChopBlanks in UID.pm (see man DBI)
- #if (datasrc =~ m/Pg/)
- #{
- # foreach my $index (keys %$hashref)
- # {
- # $$hashref{$index} = unpack("A255", $$hashref{$index})
- # if ($$hashref{$index} =~ m/ $/) ;
- # }
- #}
-
- foreach my $column (keys %{$hashref}) {
- #trim the '$' from money fields for Pg (beong HERE?)
- #(what about Pg i18n?)
- if ( datasrc =~ m/Pg/
- && $dbdef->table($table)->column($column)->type eq 'money' ) {
- ${$hashref}{$column} =~ s/^\$//;
- }
- #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) {
- # ${$hashref}{$column} =~ s/^\$//;
- #}
- }
-
- my $class = ref($proto) || $proto;
- my $self = { 'Table' => $table,
- 'Hash' => $hashref,
- };
-
- bless ($self, $class);
-
-}
-
-=item 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.
-
-=cut
-
-# Usage: @records = &FS::Search::qsearch($table,\%hash);
-# Each element of @records is a FS::Record object.
-sub qsearch {
- my($table,$record) = @_;
- my($dbh) = dbh;
-
- my(@fields)=grep exists($record->{$_}), fields($table);
-
- my($sth);
- my($statement) = "SELECT * FROM $table". ( @fields
- ? " WHERE ". join(' AND ',
- map("$_ = ". _quote($record->{$_},$table,$_), @fields)
- )
- : ''
- );
- $sth=$dbh->prepare($statement)
- or croak $dbh->errstr; #is that a little too harsh? hmm.
-
- map {
- new FS::Record ($table,$sth->fetchrow_hashref);
- } ( 1 .. $sth->execute );
-
-}
-
-=item 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 B<carp>s but returns the first. If this happens, you
-either made a logic error in asking for a single item, or your data is
-corrupted.
-
-=cut
-
-sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
- my(@result) = qsearch(@_);
- carp "Multiple records in scalar search!" if scalar(@result) > 1;
- #should warn more vehemently if the search was on a primary key?
- $result[0];
-}
-
-=item table
-
-Returns the table name.
-
-=cut
-
-sub table {
- my($self) = @_;
- $self -> {'Table'};
-}
-
-=item dbdef_table
-
-Returns the FS::dbdef_table object for the table.
-
-=cut
-
-sub dbdef_table {
- my($self)=@_;
- my($table)=$self->table;
- $dbdef->table($table);
-}
-
-=item get, getfield COLUMN
-
-Returns the value of the column/field/key COLUMN.
-
-=cut
-
-sub get {
- my($self,$field) = @_;
- # to avoid "Use of unitialized value" errors
- if ( defined ( $self->{Hash}->{$field} ) ) {
- $self->{Hash}->{$field};
- } else {
- '';
- }
-}
-sub getfield {
- get(@_);
-}
-
-=item set, setfield COLUMN, VALUE
-
-Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE.
-
-=cut
-
-sub set {
- my($self,$field,$value) = @_;
- $self->{'Hash'}->{$field} = $value;
-}
-sub setfield {
- set(@_);
-}
-
-=item AUTLOADED METHODS
-
-$record->column is a synonym for $record->get('column');
-
-$record->column('value') is a synonym for $record->set('column','value');
-
-=cut
-
-sub AUTOLOAD {
- my($self,$value)=@_;
- my($field)=$AUTOLOAD;
- $field =~ s/.*://;
- if ( defined($value) ) {
- $self->setfield($field,$value);
- } else {
- $self->getfield($field);
- }
-}
-
-=item hash
-
-Returns a list of the column/value pairs, usually for assigning to a new hash.
-
-To make a distinct duplicate of an FS::Record object, you can do:
-
- $new = new FS::Record ( $old->table, { $old->hash } );
-
-=cut
-
-sub hash {
- my($self) = @_;
- %{ $self->{'Hash'} };
-}
-
-=item hashref
-
-Returns a reference to the column/value hash.
-
-=cut
-
-sub hashref {
- my($self) = @_;
- $self->{'Hash'};
-}
-
-=item add
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub add {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
-
- #single-field unique keys are given a value if false
- #(like MySQL's AUTO_INCREMENT)
- foreach ( $dbdef->table($table)->unique->singles ) {
- $self->unique($_) unless $self->getfield($_);
- }
- #and also the primary key
- my($primary_key)=$dbdef->table($table)->primary_key;
- $self->unique($primary_key)
- if $primary_key && ! $self->getfield($primary_key);
-
- my (@fields) =
- grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- fields($table)
- ;
-
- my($sth);
- my($statement)="INSERT INTO $table ( ".
- join(', ',@fields ).
- ") VALUES (".
- join(', ',map(_quote($self->getfield($_),$table,$_), @fields)).
- ")"
- ;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $sth->execute or return $sth->errstr;
-
- '';
-}
-
-=item del
-
-Delete this record from the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub del {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
-
- my($sth);
- my($statement)="DELETE FROM $table WHERE ". join(' AND ',
- map {
- $self->getfield($_) eq ''
- ? "$_ IS NULL"
- : "$_ = ". _quote($self->getfield($_),$table,$_)
- } ( $dbdef->table($table)->primary_key )
- ? ($dbdef->table($table)->primary_key)
- : fields($table)
- );
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($rc);
- $rc=$sth->execute or return $sth->errstr;
- #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
-
- undef $self; #no need to keep object!
-
- '';
-}
-
-=item rep OLD_RECORD
-
-Replace the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub rep {
- my($new,$old)=@_;
- my($dbh)=dbh;
- my($table)=$old->table;
- my(@fields)=fields($table);
- my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields;
-
- if ( scalar(@diff) == 0 ) {
- carp "Records identical";
- return '';
- }
-
- return "Records not in same table!" unless $new->table eq $table;
-
- my($sth);
- my($statement)="UPDATE $table SET ". join(', ',
- map {
- "$_ = ". _quote($new->getfield($_),$table,$_)
- } @diff
- ). ' WHERE '.
- join(' AND ',
- map {
- $old->getfield($_) eq ''
- ? "$_ IS NULL"
- : "$_ = ". _quote($old->getfield($_),$table,$_)
-# } @fields
-# } ( primary_key($table) ? (primary_key($table)) : @fields )
- } ( $dbdef->table($table)->primary_key
- ? ($dbdef->table($table)->primary_key)
- : @fields
- )
- )
- ;
- #warn $statement;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($rc);
- $rc=$sth->execute or return $sth->errstr;
- #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
-
- '';
-
-}
-
-=item unique COLUMN
-
-Replaces COLUMN in record with a unique number. Called by the B<add> method
-on primary keys and single-field unique columns (see L<FS::dbdef_table>).
-Returns the new value.
-
-=cut
-
-sub unique {
- my($self,$field) = @_;
- my($table)=$self->table;
-
- croak("&FS::UID::checkruid failed") unless &checkruid;
-
- croak "Unique called on field $field, but it is ",
- $self->getfield($field),
- ", not null!"
- if $self->getfield($field);
-
- #warn "table $table is tainted" if is_tainted($table);
- #warn "field $field is tainted" if is_tainted($field);
-
- &swapuid;
- my($counter) = new File::CounterFile "$table.$field",0;
-# hack for web demo
-# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
-# my($user)=$1;
-# my($counter) = new File::CounterFile "$user/$table.$field",0;
-# endhack
-
- my($index)=$counter->inc;
- $index=$counter->inc
- while qsearchs($table,{$field=>$index}); #just in case
- &swapuid;
-
- $index =~ /^(\d*)$/;
- $index=$1;
-
- $self->setfield($field,$index);
-
-}
-
-=item ut_float COLUMN
-
-Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May not be
-null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_float {
- my($self,$field)=@_ ;
- ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
- $self->getfield($field) =~ /^(\d+)$/ ||
- $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
- $self->getfield($field) =~ /^(\d+e\d+)$/)
- or return "Illegal or empty (float) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_number COLUMN
-
-Check/untaint simple numeric data (whole numbers). May not be null. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_number {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\d+)$/
- or return "Illegal or empty (numeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_numbern COLUMN
-
-Check/untaint simple numeric data (whole numbers). May be null. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_numbern {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\d*)$/
- or return "Illegal (numeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_money COLUMN
-
-Check/untaint monetary numbers. May be negative. Set to 0 if null. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_money {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
- or return "Illegal (money) $field!";
- $self->setfield($field,"$1$2$3" || 0);
- '';
-}
-
-=item ut_text COLUMN
-
-Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
-May not be null. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub ut_text {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
- or return "Illegal or empty (text) $field";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_textn COLUMN
-
-Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
-May be null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_textn {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
- or return "Illegal (text) $field";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_alpha COLUMN
-
-Check/untaint alphanumeric strings (no spaces). May not be null. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alpha {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w+)$/
- or return "Illegal or empty (alphanumeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_alpha COLUMN
-
-Check/untaint alphanumeric strings (no spaces). May be null. If there is an
-error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alphan {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w*)$/
- or return "Illegal (alphanumeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_phonen COLUMN
-
-Check/untaint phone numbers. May be null. If there is an error, returns
-the error, otherwise returns false.
-
-=cut
-
-sub ut_phonen {
- my($self,$field)=@_;
- my $phonen = $self->getfield($field);
- if ( $phonen eq '' ) {
- $self->setfield($field,'');
- } else {
- $phonen =~ s/\D//g;
- $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
- or return "Illegal (phone) $field!";
- $phonen = "$1-$2-$3";
- $phonen .= " x$4" if $4;
- $self->setfield($field,$phonen);
- }
- '';
-}
-
-=item ut_anything COLUMN
-
-Untaints arbitrary data. Be careful.
-
-=cut
-
-sub ut_anything {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(.*)$/ or return "Illegal $field!";
- $self->setfield($field,$1);
- '';
-}
-
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item reload_dbdef([FILENAME])
-
-Load a database definition (see L<FS::dbdef>), optionally from a non-default
-filename. This command is executed at startup unless
-I<$FS::Record::setup_hack> is true. Returns a FS::dbdef object.
-
-=cut
-
-sub reload_dbdef {
- my $file = shift || $dbdef_file;
- $dbdef = load FS::dbdef ($file);
-}
-
-=item dbdef
-
-Returns the current database definition. See L<FS::dbdef>.
-
-=cut
-
-sub dbdef { $dbdef; }
-
-=item _quote VALUE, TABLE, COLUMN
-
-This is an internal function used to construct SQL statements. It returns
-VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
-type (see L<dbdef_column>) does not end in `char' or `binary'.
-
-=cut
-
-sub _quote {
- my($value,$table,$field)=@_;
- my($dbh)=dbh;
- if ( $value =~ /^\d+(\.\d+)?$/ &&
-# ! ( datatype($table,$field) =~ /^char/ )
- ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i )
- ) {
- $value;
- } else {
- $dbh->quote($value);
- }
-}
-
-=item hfields TABLE
-
-This is depriciated. Don't use it.
-
-It returns a hash-type list with the fields of this record's table set true.
-
-=cut
-
-sub hfields {
- carp "hfields is depriciated";
- my($table)=@_;
- my(%hash);
- foreach (fields($table)) {
- $hash{$_}=1;
- }
- \%hash;
-}
-
-=item fields TABLE
-
-This returns a list of the columns in this record's table
-(See L<dbdef_table>).
-
-=cut
-
-# Usage: @fields = fields($table);
-sub fields {
- my($table) = @_;
- #my(@fields) = $dbdef->table($table)->columns;
- croak "Usage: \@fields = fields(\$table)" unless $table;
- my($table_obj) = $dbdef->table($table);
- croak "Unknown table $table" unless $table_obj;
- $table_obj->columns;
-}
-
-#sub _dump {
-# my($self)=@_;
-# join("\n", map {
-# "$_: ". $self->getfield($_). "|"
-# } (fields($self->table)) );
-#}
-
-#sub DESTROY {
-# my $self = shift;
-# #use Carp qw(cluck);
-# #cluck "DESTROYING $self";
-# warn "DESTROYING $self";
-#}
-
-#sub is_tainted {
-# return ! eval { join('',@_), kill 0; 1; };
-# }
-
-=back
-
-=head1 BUGS
-
-This module should probably be renamed, since much of the functionality is
-of general use. It is not completely unlike Adapter::DBI (see below).
-
-Exported qsearch and qsearchs should be depriciated in favor of method calls
-(against an FS::Record object like the old search and searchs that qsearch
-and qsearchs were on top of.)
-
-The whole fields / hfields mess should be removed.
-
-The various WHERE clauses should be subroutined.
-
-table string should be depriciated in favor of FS::dbdef_table.
-
-No doubt we could benefit from a Tied hash. Documenting how exists / defined
-true maps to the database (and WHERE clauses) would also help.
-
-The ut_ methods should ask the dbdef for a default length.
-
-ut_sqltype (like ut_varchar) should all be defined
-
-A fallback check method should be provided with uses the dbdef.
-
-The ut_money method assumes money has two decimal digits.
-
-The Pg money kludge in the new method only strips `$'.
-
-The ut_phonen method assumes US-style phone numbers.
-
-The _quote function should probably use ut_float instead of a regex.
-
-All the subroutines probably should be methods, here or elsewhere.
-
-=head1 SEE ALSO
-
-L<FS::dbdef>, L<FS::UID>, L<DBI>
-
-Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jun-2 - 9, 19, 25, 27, 30
-
-DBI version
-ivan@sisd.com 97-nov-8 - 12
-
-cleaned up, added autoloaded $self->any_field calls, moved DBI login stuff
-to FS::UID
-ivan@sisd.com 97-nov-21-23
-
-since AUTO_INCREMENT is MySQL specific, use my own unique number generator
-(again)
-ivan@sisd.com 97-dec-4
-
-untaint $user in unique (web demo hack...bah)
-make unique skip multiple-field unique's from dbdef
-ivan@sisd.com 97-dec-11
-
-merge with FS::Search, which after all was just alternate constructors for
-FS::Record objects. Makes lots of things cleaner. :)
-ivan@sisd.com 97-dec-13
-
-use FS::dbdef::primary key in replace searches, hopefully for all practical
-purposes the string/number problem in SQL statements should be gone?
-(SQL bites)
-ivan@sisd.com 98-jan-20
-
-Put all SQL statments in $statment before we $sth=$dbh->prepare( them,
-for debugging reasons (warn $statement) ivan@sisd.com 98-feb-19
-
-(sigh)... use dbdef type (char, etc.) instead of a regex to decide
-what to quote in _quote (more sillines...) SQL bites.
-ivan@sisd.com 98-feb-20
-
-more friendly error messages ivan@sisd.com 98-mar-13
-
-Added import of datasrc from FS::UID to allow Pg6.3 to work
-Added code to right-trim strings read from Pg6.3 databases
-Modified 'add' to only insert fields that actually have data
-Added ut_float to handle floating point numbers (for sales tax).
-Pg6.3 does not have a "SHOW FIELDS" statement, so I faked it 8).
- bmccane@maxbaud.net 98-apr-3
-
-commented out Pg wrapper around `` Modified 'add' to only insert fields that
-actually have data '' ivan@sisd.com 98-apr-16
-
-dbdef usage changes ivan@sisd.com 98-jun-1
-
-sub fields now asks dbdef, not database ivan@sisd.com 98-jun-2
-
-added debugging method ->_dump ivan@sisd.com 98-jun-16
-
-use FS::dbdef::primary key in delete searches as well as replace
-searches (SQL still bites) ivan@sisd.com 98-jun-22
-
-sub dbdef_table ivan@sisd.com 98-jun-28
-
-removed Pg wrapper around `` Modified 'add' to only insert fields that
-actually have data '' ivan@sisd.com 98-jul-14
-
-sub fields croaks on errors ivan@sisd.com 98-jul-17
-
-$rc eq '0E0' doesn't mean we couldn't delete for all rdbmss
-ivan@sisd.com 98-jul-18
-
-commented out code to right-trim strings read from Pg6.3 databases;
-ChopBlanks is in UID.pm ivan@sisd.com 98-aug-16
-
-added code (with Pg wrapper) to deal with Pg money fields
-ivan@sisd.com 98-aug-18
-
-added pod documentation ivan@sisd.com 98-sep-6
-
-ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::SSH;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $ssh $scp);
-use Exporter;
-use IPC::Open2;
-use IPC::Open3;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(ssh scp issh iscp sshopen2 sshopen3);
-
-$ssh="ssh";
-$scp="scp";
-
-=head1 NAME
-
-FS::SSH - Subroutines to call ssh and scp
-
-=head1 SYNOPSIS
-
- use FS::SSH qw(ssh scp issh iscp sshopen2 sshopen3);
-
- ssh($host, $command);
-
- issh($host, $command);
-
- scp($source, $destination);
-
- iscp($source, $destination);
-
- sshopen2($host, $reader, $writer, $command);
-
- sshopen3($host, $reader, $writer, $error, $command);
-
-=head1 DESCRIPTION
-
- Simple wrappers around ssh and scp commands.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item ssh HOST, COMMAND
-
-Calls ssh in batch mode.
-
-=cut
-
-sub ssh {
- my($host,$command)=@_;
- my(@cmd)=($ssh, "-o", "BatchMode yes", $host, $command);
-# print join(' ',@cmd),"\n";
-#0;
- system(@cmd);
-}
-
-=item issh HOST, COMMAND
-
-Prints the ssh command to be executed, waits for the user to confirm, and
-(optionally) executes the command.
-
-=cut
-
-sub issh {
- my($host,$command)=@_;
- my(@cmd)=($ssh, $host, $command);
- print join(' ',@cmd),"\n";
- if ( &_yesno ) {
- ###print join(' ',@cmd),"\n";
- system(@cmd);
- }
-}
-
-=item scp SOURCE, DESTINATION
-
-Calls scp in batch mode.
-
-=cut
-
-sub scp {
- my($src,$dest)=@_;
- my(@cmd)=($scp,"-Bprq",$src,$dest);
-# print join(' ',@cmd),"\n";
-#0;
- system(@cmd);
-}
-
-=item iscp SOURCE, DESTINATION
-
-Prints the scp command to be executed, waits for the user to confirm, and
-(optionally) executes the command.
-
-=cut
-
-sub iscp {
- my($src,$dest)=@_;
- my(@cmd)=($scp,"-pr",$src,$dest);
- print join(' ',@cmd),"\n";
- if ( &_yesno ) {
- ###print join(' ',@cmd),"\n";
- system(@cmd);
- }
-}
-
-=item sshopen2 HOST, READER, WRITER, COMMAND
-
-Connects the supplied filehandles to the ssh process (in batch mode).
-
-=cut
-
-sub sshopen2 {
- my($host,$reader,$writer,$command)=@_;
- open2($reader,$writer,$ssh,'-o','Batchmode yes',$host,$command);
-}
-
-=item sshopen3 HOST, WRITER, READER, ERROR, COMMAND
-
-Connects the supplied filehandles to the ssh process (in batch mode).
-
-=cut
-
-sub sshopen3 {
- my($host,$writer,$reader,$error,$command)=@_;
- open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command);
-}
-
-sub _yesno {
- print "Proceed [y/N]:";
- my($x)=scalar(<STDIN>);
- $x =~ /^y/i;
-}
-
-=head1 BUGS
-
-Not OO.
-
-scp stuff should transparantly use rsync-over-ssh instead.
-
-=head1 SEE ALSO
-
-L<ssh>, L<scp>, L<IPC::Open2>, L<IPC::Open3>
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-17
-
-added sshopen2 and sshopen3 ivan@sisd.com 98-mar-9
-
-added iscp ivan@sisd.com 98-jul-25
-now iscp asks y/n, issh and took out path ivan@sisd.com 98-jul-30
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::UID;
-
-use strict;
-use vars qw(
- @ISA @EXPORT_OK $cgi $dbh $freeside_uid $conf $datasrc $db_user $db_pass
-);
-use Exporter;
-use Carp;
-use DBI;
-use FS::Conf;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
- adminsuidsetup getotaker dbh datasrc);
-
-$freeside_uid = scalar(getpwnam('freeside'));
-
-my $conf = new FS::Conf;
-($datasrc, $db_user, $db_pass) = $conf->config('secrets')
- or die "Can't get secrets: $!";
-
-=head1 NAME
-
-FS::UID - Subroutines for database login and assorted other stuff
-
-=head1 SYNOPSIS
-
- use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
- checkeuid checkruid swapuid);
-
- adminsuidsetup;
-
- $cgi = new CGI::Base;
- $cgi->get;
- $dbh = cgisuidsetup($cgi);
-
- $dbh = dbh;
-
- $datasrc = datasrc;
-
-=head1 DESCRIPTION
-
-Provides a hodgepodge of subroutines.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item 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 database handle (usually you don't need this).
-
-=cut
-
-sub adminsuidsetup {
-
- $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
- $ENV{'SHELL'} = '/bin/sh';
- $ENV{'IFS'} = " \t\n";
- $ENV{'CDPATH'} = '';
- $ENV{'ENV'} = '';
- $ENV{'BASH_ENV'} = '';
-
- croak "Not running uid freeside!" unless checkeuid();
- $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- # hack for web demo
- # my($user)=getotaker();
- # $dbh = DBI->connect("$datasrc:$user",$db_user,$db_pass, {
- 'AutoCommit' => 'true',
- 'ChopBlanks' => 'true',
- } ) or die "DBI->connect error: $DBI::errstr\n";;
-
- swapuid(); #go to non-privledged user if running setuid freeside
-
- $dbh;
-}
-=item cgisuidsetup CGI::Base_OBJECT
-
-Stores the CGI::Base_OBJECT for later use.
-Runs adminsuidsetup.
-
-=cut
-
-sub cgisuidsetup {
- $cgi=$_[0];
- adminsuidsetup;
-}
-
-=item dbh
-
-Returns the DBI database handle.
-
-=cut
-
-sub dbh {
- $dbh;
-}
-
-=item datasrc
-
-Returns the DBI data source.
-
-=cut
-
-sub datasrc {
- $datasrc;
-}
-
-#hack for web demo
-#sub setdbh {
-# $dbh=$_[0];
-#}
-
-sub suidsetup {
- croak "suidsetup depriciated";
-}
-
-=item getotaker
-
-Returns the current Freeside user. Currently that means the CGI REMOTE_USER,
-or 'freeside'.
-
-=cut
-
-sub getotaker {
- if ($cgi && defined $cgi->var('REMOTE_USER')) {
- return $cgi->var('REMOTE_USER'); #for now
- } else {
- 'freeside';
- }
-}
-
-=item checkeuid
-
-Returns true if effective UID is that of the freeside user.
-
-=cut
-
-sub checkeuid {
- ( $> == $freeside_uid );
-}
-
-=item checkruid
-
-Returns true if the real UID is that of the freeside user.
-
-=cut
-
-sub checkruid {
- ( $< == $freeside_uid );
-}
-
-=item swapuid
-
-Swaps real and effective UIDs.
-
-=cut
-
-sub swapuid {
- ($<,$>) = ($>,$<);
-}
-
-=back
-
-=head1 BUGS
-
-Not OO.
-
-No capabilities yet. When mod_perl and Authen::DBI are implemented,
-cgisuidsetup will go away as well.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<CGI::Base>, L<DBI>
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jun-4 - 9
-
-untaint otaker ivan@voicenet.com 97-jul-7
-
-generalize and auto-get uid (getotaker still needs to be db'ed)
-ivan@sisd.com 97-nov-10
-
-&cgisuidsetup logs into database. other cleaning.
-ivan@sisd.com 97-nov-22,23
-
-&adminsuidsetup logs into database with otaker='freeside' (for
-automated tasks like billing)
-ivan@sisd.com 97-dec-13
-
-added sub datasrc for fs-setup ivan@sisd.com 98-feb-21
-
-datasrc, user and pass now come from conf/secrets ivan@sisd.com 98-jun-28
-
-added ChopBlanks to DBI call (see man DBI) ivan@sisd.com 98-aug-16
-
-pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
-inlined suidsetup
-ivan@sisd.com 98-sep-12
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::agent;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::agent - Object methods for agent records
-
-=head1 SYNOPSIS
-
- use FS::agent;
-
- $record = create FS::agent \%hash;
- $record = create FS::agent { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::agent object represents an agent. Every customer has an agent. Agents
-can be used to track things like resellers or salespeople. FS::agent inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item agemtnum - primary key (assigned automatically for new agents)
-
-=item agent - Text name of this agent
-
-=item typenum - Agent type. See L<FS::agent_type>
-
-=item prog - For future use.
-
-=item freq - For future use.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new agent. To add the agent to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent',$hashref);
-}
-
-=item insert
-
-Adds this agent to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this agent from the database. Only agents with no customers can be
-deleted. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't delete an agent with customers!"
- if qsearch('cust_main',{'agentnum' => $self->agentnum});
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an agent record!" unless $old->table eq "agent";
- return "Can't change agentnum!"
- unless $old->getfield('agentnum') eq $new->getfield('agentnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid agent. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a agent record!" unless $self->table eq "agent";
-
- my($error)=
- $self->ut_numbern('agentnum')
- or $self->ut_text('agent')
- or $self->ut_number('typenum')
- or $self->ut_numbern('freq')
- or $self->ut_textn('prog')
- ;
- return $error if $error;
-
- return "Unknown typenum!"
- unless qsearchs('agent_type',{'typenum'=> $self->getfield('typenum') });
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-Class dealing with agent (resellers)
-
-ivan@sisd.com 97-nov-13, 97-dec-10
-
-pod, added check in ->delete ivan@sisd.com 98-sep-22
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::agent_type;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(qsearch fields);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::agent_type - Object methods for agent_type records
-
-=head1 SYNOPSIS
-
- use FS::agent_type;
-
- $record = create FS::agent_type \%hash;
- $record = create FS::agent_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::agent_type object represents an agent type. Every agent (see
-L<FS::agent>) has an agent type. Agent types define which packages (see
-L<FS::part_pkg>) may be purchased by customers (see L<FS::cust_main>), via
-FS::type_pkgs records (see L<FS::type_pkgs>). FS::agent_type inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typenum - primary key (assigned automatically for new agent types)
-
-=item atype - Text name of this agent type
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new agent type. To add the agent type to the database, see
-L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent_type')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent_type',$hashref);
-
-}
-
-=item insert
-
-Adds this agent type to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this agent type from the database. Only agent types with no agents
-can be deleted. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't delete an agent_type with agents!"
- if qsearch('agent',{'typenum' => $self->typenum});
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a agent_type record!" unless $old->table eq "agent_type";
- return "Can't change typenum!"
- unless $old->getfield('typenum') eq $new->getfield('typenum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid agent type. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a agent_type record!" unless $self->table eq "agent_type";
-
- $self->ut_numbern('typenum')
- or $self->ut_text('atype');
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent>, L<FS::type_pkgs>, L<FS::cust_main>,
-L<FS::part_pkg>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-Class for the different sets of allowable packages you can assign to an
-agent.
-
-ivan@sisd.com 97-nov-13
-
-ut_ FS::Record methods
-ivan@sisd.com 97-dec-10
-
-Changed 'type' to 'atype' because Pg6.3 reserves the type word
- bmccane@maxbaud.net 98-apr-3
-
-pod, added check in delete ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_bill;
-
-use strict;
-use vars qw(@ISA $conf $add1 $add2 $add3 $add4);
-use Exporter;
-use Date::Format;
-use FS::Record qw(fields qsearch qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-
-$conf = new FS::Conf;
-
-($add1,$add2,$add3,$add4) = $conf->config('address');
-
-=head1 NAME
-
-FS::cust_bill - Object methods for cust_bill records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill;
-
- $record = create FS::cust_bill \%hash;
- $record = create FS::cust_bill { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
-
- @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
-
- ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
-
- @cust_pay_objects = $cust_bill->cust_pay;
-
- @lines = $cust_bill->print_text;
- @lines = $cust_bill->print_text $time;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill object represents an invoice. FS::cust_bill inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item invnum - primary key (assigned automatically for new invoices)
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item charged - amount of this invoice
-
-=item owed - amount still outstanding on this invoice, which is charged minus
-all payments (see L<FS::cust_pay>).
-
-=item printed - how many times this invoice has been printed automatically
-(see L<FS::cust_main/"collect">).
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new invoice. To add the invoice to the database, see L<"insert">.
-Invoices are normally created by calling the bill method of a customer object
-(see L<FS::cust_main>).
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill',$hashref);
-}
-
-=item insert
-
-Adds this invoice to the database ("Posts" the invoice). If there is an error,
-returns the error, otherwise returns false.
-
-When adding new invoices, owed must be charged (or null, in which case it is
-automatically set to charged).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->setfield('owed',$self->charged) if $self->owed eq '';
- return "owed != charged!"
- unless $self->owed == $self->charged;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. I don't remove invoices because there would then be
-no record you ever posted this invoice (which is bad, no?)
-
-=cut
-
-sub delete {
- return "Can't remove invoice!"
- #my($self)=@_;
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Only owed and printed may be changed. Owed is normally updated by creating and
-inserting a payment (see L<FS::cust_pay>). Printed is normally updated by
-calling the collect method of a customer object (see L<FS::cust_main>).
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_bill record!" unless $old->table eq "cust_bill";
- return "Can't change invnum!"
- unless $old->getfield('invnum') eq $new->getfield('invnum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change _date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change charged!"
- unless $old->getfield('charged') eq $new->getfield('charged');
- return "(New) owed can't be > (new) charged!"
- if $new->getfield('owed') > $new->getfield('charged');
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid invoice. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_bill record!" unless $self->table eq "cust_bill";
- my($recref) = $self->hashref;
-
- $recref->{invnum} =~ /^(\d*)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- #$recref->{charged} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} = $1;
-
- $recref->{owed} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal owed";
- $recref->{owed} = $1;
-
- $recref->{printed} =~ /^(\d*)$/ or return "Illegal printed";
- $recref->{printed} = $1 || '0';
-
- ''; #no error
-}
-
-=item previous
-
-Returns a list consisting of the total previous balance for this customer,
-followed by the previous outstanding invoices (as FS::cust_bill objects also).
-
-=cut
-
-sub previous {
- my($self)=@_;
- my($total)=0;
- my(@cust_bill) = sort { $a->_date <=> $b->_date }
- grep { $_->owed != 0 && $_->_date < $self->_date }
- qsearch('cust_bill',{ 'custnum' => $self->custnum } )
- ;
- foreach (@cust_bill) { $total += $_->owed; }
- $total, @cust_bill;
-}
-
-=item cust_bill_pkg
-
-Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
-
-=cut
-
-sub cust_bill_pkg {
- my($self)=@_;
- qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
-}
-
-=item cust_credit
-
-Returns a list consisting of the total previous credited (see
-L<FS::cust_credit>) for this customer, followed by the previous outstanding
-credits (FS::cust_credit objects).
-
-=cut
-
-sub cust_credit {
- my($self)=@_;
- my($total)=0;
- my(@cust_credit) = sort { $a->_date <=> $b->date }
- grep { $_->credited != 0 && $_->_date < $self->_date }
- qsearch('cust_credit', { 'custnum' => $self->custnum } )
- ;
- foreach (@cust_credit) { $total += $_->credited; }
- $total, @cust_credit;
-}
-
-=item cust_pay
-
-Returns all payments (see L<FS::cust_pay>) for this invoice.
-
-=cut
-
-sub cust_pay {
- my($self)=@_;
- sort { $a->_date <=> $b->date }
- qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
- ;
-}
-
-=item print_text [TIME];
-
-Returns an ASCII invoice, as a list of lines.
-
-TIME an optional value used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub print_text {
-
- my($self,$today)=@_;
- $today ||= time;
- my($invnum)=$self->invnum;
- my($cust_main) = qsearchs('cust_main',
- { 'custnum', $self->custnum } );
- $cust_main->setfield('payname',
- $cust_main->first. ' '. $cust_main->getfield('last')
- ) unless $cust_main->payname;
-
- my($pr_total,@pr_cust_bill) = $self->previous; #previous balance
- my($cr_total,@cr_cust_credit) = $self->cust_credit; #credits
- my($balance_due) = $self->owed + $pr_total - $cr_total;
-
- #overdue?
- my($overdue) = (
- $balance_due > 0
- && $today > $self->_date
- && $self->printed > 1
- );
-
- #printing bits here
-
- local($SIG{CHLD}) = sub { wait() };
- $|=1;
- my($pid)=open(CHILD,"-|");
- die "Can't fork: $!" unless defined($pid);
-
- if ($pid) { #parent
- my(@collect)=<CHILD>;
- close CHILD;
- return @collect;
- } else { #child
-
- my($description,$amount);
- my(@buf);
-
- #define format stuff
- $%=0;
- $= = 35;
- local($^L) = <<END;
-
-
-
-
-
-
-
-END
-
- #format address
- my($l,@address)=(0,'','','','','');
- $address[$l++]=$cust_main->company if $cust_main->company;
- $address[$l++]=$cust_main->address1;
- $address[$l++]=$cust_main->address2 if $cust_main->address2;
- $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ".
- $cust_main->zip;
- $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
-
- #previous balance
- foreach ( @pr_cust_bill ) {
- push @buf, (
- "Previous Balance, Invoice #". $_->invnum.
- " (". time2str("%x",$_->_date). ")",
- '$'. sprintf("%10.2f",$_->owed)
- );
- }
- if (@pr_cust_bill) {
- push @buf,('','-----------');
- push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
- push @buf,('','');
- }
-
- #new charges
- foreach ( $self->cust_bill_pkg ) {
-
- if ( $_->pkgnum ) {
-
- my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
- my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
- my($pkg)=$part_pkg->pkg;
-
- push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) )
- if $_->setup != 0;
- push @buf, (
- "$pkg (" . time2str("%x",$_->sdate) . " - " .
- time2str("%x",$_->edate) . ")",
- '$' . sprintf("%10.2f",$_->recur)
- ) if $_->recur != 0;
-
- } else { #pkgnum Tax
- push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
- if $_->setup != 0;
- }
- }
-
- push @buf,('','-----------');
- push @buf,('Total New Charges',
- '$' . sprintf("%10.2f",$self->charged) );
- push @buf,('','');
-
- push @buf,('','-----------');
- push @buf,('Total Charges',
- '$' . sprintf("%10.2f",$self->charged + $pr_total) );
- push @buf,('','');
-
- #credits
- foreach ( @cr_cust_credit ) {
- push @buf,(
- "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
- '$' . sprintf("%10.2f",$_->credited)
- );
- }
-
- #get & print payments
- foreach ( $self->cust_pay ) {
- push @buf,(
- "Payment received ". time2str("%x",$_->_date ),
- '$' . sprintf("%10.2f",$_->paid )
- );
- }
-
- #balance due
- push @buf,('','-----------');
- push @buf,('Balance Due','$' .
- sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
-
- #now print
-
- my($tot_pages)=int(scalar(@buf)/30); #15 lines, 2 values per line
- $tot_pages++ if scalar(@buf) % 30;
-
- while (@buf) {
- $description=shift(@buf);
- $amount=shift(@buf);
- write;
- }
- ($description,$amount)=('','');
- write while ( $- );
- print $^L;
-
- exit; #kid
-
- format STDOUT_TOP =
-
- @|||||||||||||||||||
- "Invoice"
- @||||||||||||||||||| @<<<<<<< @<<<<<<<<<<<
-{
- ( $tot_pages != 1 ) ? "Page $% of $tot_pages" : '',
- time2str("%x",( $self->_date )), "FS-$invnum"
-}
-
-
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add1
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add2
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add3
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add4
-
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-{ $cust_main->payname,
- ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo )
- ? "P.O. #". $cust_main->payinfo : ''
-}
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[0],''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[1],$overdue ? "* This invoice is now PAST DUE! *" : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[2],$overdue ? " Please forward payment promptly " : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[3],$overdue ? "to avoid interruption of service." : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[4],''
-
-
-
-.
-
- format STDOUT =
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
- $description,$amount
-.
-
- } #endchild
-
-}
-
-=back
-
-=head1 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 ($=).
-
-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?
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_pay>, L<FS::cust_bill_pkg>,
-L<FS::cust_credit>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1
-
-small fix for new API ivan@sisd.com 98-mar-14
-
-charges can be negative ivan@sisd.com 98-jul-13
-
-pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_bill_pkg;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_bill_pkg - Object methods for cust_bill_pkg records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg;
-
- $record = create FS::cust_bill_pkg \%hash;
- $record = create FS::cust_bill_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg object represents an invoice line item.
-FS::cust_bill_pkg inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item invnum - invoice (see L<FS::cust_bill>)
-
-=item pkgnum - package (see L<FS::cust_pkg>)
-
-=item setup - setup fee
-
-=item recur - recurring fee
-
-=item sdate - starting date of recurring fee
-
-=item edate - ending date of recurring fee
-
-=back
-
-sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new line item. To add the line item to the database, see
-L<"insert">. Line items are normally created by calling the bill method of a
-customer object (see L<FS::cust_main>).
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill_pkg',$hashref);
-
-}
-
-=item insert
-
-Adds this line item to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. I don't remove line items because there would then be
-no record the items ever existed (which is bad, no?)
-
-=cut
-
-sub delete {
- return "Can't delete cust_bill_pkg records!";
- #my($self)=@_;
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented. This would be even more of an accounting nightmare
-than deleteing the items. Just don't do it.
-
-=cut
-
-sub replace {
- return "Can't modify cust_bill_pkg records!";
- #my($new,$old)=@_;
- #return "(Old) Not a cust_bill_pkg record!"
- # unless $old->table eq "cust_bill_pkg";
- #
- #$new->check or
- #$new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid line item. If there is an
-error, returns the error, otherwise returns false. Called by the insert
-method.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_bill_pkg record!" unless $self->table eq "cust_bill_pkg";
-
- my($error)=
- $self->ut_number('pkgnum')
- or $self->ut_number('invnum')
- or $self->ut_money('setup')
- or $self->ut_money('recur')
- or $self->ut_numbern('sdate')
- or $self->ut_numbern('edate')
- ;
- return $error if $error;
-
- if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
- return "Unknown pkgnum ".$self->pkgnum
- unless qsearchs('cust_pkg',{'pkgnum'=> $self->pkgnum });
- }
-
- return "Unknown invnum"
- unless qsearchs('cust_bill',{'invnum'=> $self->invnum });
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
-from the base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 98-mar-13
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_credit;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_credit - Object methods for cust_credit records
-
-=head1 SYNOPSIS
-
- use FS::cust_credit;
-
- $record = create FS::cust_credit \%hash;
- $record = create FS::cust_credit { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_credit object represents a credit. FS::cust_credit inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item crednum - primary key (assigned automatically for new credits)
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item amount - amount of the credit
-
-=item credited - how much of this credit that is still outstanding, which is
-amount minus all refunds (see L<FS::cust_refund>).
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
-
-=item reason - text
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new credit. To add the credit to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_credit')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_credit',$hashref);
-}
-
-=item insert
-
-Adds this credit to the database ("Posts" the credit). If there is an error,
-returns the error, otherwise returns false.
-
-When adding new invoices, credited must be amount (or null, in which case it is
-automatically set to amount).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->setfield('credited',$self->amount) if $self->credited eq '';
- return "credited != amount!"
- unless $self->credited == $self->amount;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't remove credit!"
- #my($self)=@_;
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Only credited may be changed. Credited is normally updated by creating and
-inserting a refund (see L<FS::cust_refund>).
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_credit record!" unless $old->table eq "cust_credit";
- return "Can't change crednum!"
- unless $old->getfield('crednum') eq $new->getfield('crednum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change amount!"
- unless $old->getfield('amount') eq $new->getfield('amount');
- return "(New) credited can't be > (new) amount!"
- if $new->getfield('credited') > $new->getfield('amount');
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid credit. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_credit record!" unless $self->table eq "cust_credit";
- my($recref) = $self->hashref;
-
- $recref->{crednum} =~ /^(\d*)$/ or return "Illegal crednum";
- $recref->{crednum} = $1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- $recref->{amount} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal amount";
- $recref->{amount} = $1;
-
- $recref->{credited} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal credited";
- $recref->{credited} = $1;
-
- #$recref->{otaker} =~ /^(\w+)$/ or return "Illegal otaker";
- #$recref->{otaker} = $1;
- $self->otaker(getotaker);
-
- $self->ut_textn('reason');
-
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 98-mar-17
-
-pod, otaker from FS::UID ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-#this is so kludgy i'd be embarassed if it wasn't cybercash's fault
-package main;
-use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
-
-package FS::cust_main;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $conf $lpr $processor $xaction $E_NoErr);
-use Safe;
-use Exporter;
-use Carp;
-use Time::Local;
-use Date::Format;
-use Date::Manip;
-use Business::CreditCard;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearchs qsearch);
-use FS::cust_pkg;
-use FS::cust_bill;
-use FS::cust_bill_pkg;
-use FS::cust_pay;
-#use FS::cust_pay_batch;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-$conf = new FS::Conf;
-$lpr = $conf->config('lpr');
-
-if ( $conf->exists('cybercash3.2') ) {
- require CCMckLib3_2;
- #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
- require CCMckDirectLib3_2;
- #qw(SendCC2_1Server);
- require CCMckErrno3_2;
- #qw(MCKGetErrorMessage $E_NoErr);
- import CCMckErrno3_2 qw($E_NoErr);
- my $merchant_conf;
- ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
- my $status = &CCMckLib3_2::InitConfig($merchant_conf);
- if ( $status != $E_NoErr ) {
- warn "CCMckLib3_2::InitConfig error:\n";
- foreach my $key (keys %CCMckLib3_2::Config) {
- warn " $key => $CCMckLib3_2::Config{$key}\n"
- }
- my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
- die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
- }
- $processor='cybercash3.2';
-} elsif ( $conf->exists('cybercash2') ) {
- require CCLib;
- #qw(sendmserver);
- ( $main::paymentserverhost,
- $main::paymentserverport,
- $main::paymentserversecret,
- $xaction,
- ) = $conf->config('cybercash2');
- $processor='cybercash2';
-}
-
-=head1 NAME
-
-FS::cust_main - Object methods for cust_main records
-
-=head1 SYNOPSIS
-
- use FS::cust_main;
-
- $record = create FS::cust_main \%hash;
- $record = create FS::cust_main { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- @cust_pkg = $record->all_pkgs;
-
- @cust_pkg = $record->ncancelled_pkgs;
-
- $error = $record->bill;
- $error = $record->bill %options;
- $error = $record->bill 'time' => $time;
-
- $error = $record->collect;
- $error = $record->collect %options;
- $error = $record->collect 'invoice_time' => $time,
- 'batch_card' => 'yes',
- 'report_badcard' => 'yes',
- ;
-
-=head1 DESCRIPTION
-
-An FS::cust_main object represents a customer. FS::cust_main inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item custnum - primary key (assigned automatically for new customers)
-
-=item agentnum - agent (see L<FS::agent>)
-
-=item refnum - referral (see L<FS::part_referral>)
-
-=item first - name
-
-=item last - name
-
-=item ss - social security number (optional)
-
-=item company - (optional)
-
-=item address1
-
-=item address2 - (optional)
-
-=item city
-
-=item county - (optional, see L<FS::cust_main_county>)
-
-=item state - (see L<FS::cust_main_county>)
-
-=item zip
-
-=item country - (see L<FS::cust_main_county>)
-
-=item daytime - phone (optional)
-
-=item night - phone (optional)
-
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
-
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
-
-=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
-
-=item payname - name on card or billing name
-
-=item tax - tax exempt, empty or `Y'
-
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new customer. To add the customer to the database, see L<"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 I<hash> method.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my $field;
- #foreach $field (fields('cust_main')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main',$hashref);
-}
-
-=item insert
-
-Adds this customer to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- #no callbacks in check, only data checks
- #local $SIG{HUP} = 'IGNORE';
- #local $SIG{INT} = 'IGNORE';
- #local $SIG{QUIT} = 'IGNORE';
- #local $SIG{TERM} = 'IGNORE';
- #local $SIG{TSTP} = 'IGNORE';
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. Maybe cancel all of this customer's
-packages (cust_pkg)?
-
-I don't remove the customer record in the database because there would then
-be no record the customer ever existed (which is bad, no?)
-
-=cut
-
-# Usage: $error = $record -> delete;
-sub delete {
- return "Can't (yet?) delete customers.";
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main record!" unless $old->table eq "cust_main";
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid customer record. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and repalce methods.
-
-=cut
-
-sub check {
- my($self)=@_;
-
- return "Not a cust_main record!" unless $self->table eq "cust_main";
-
- my $error =
- $self->ut_number('agentnum')
- || $self->ut_number('refnum')
- || $self->ut_textn('company')
- || $self->ut_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('county')
- || $self->ut_text('state')
- || $self->ut_phonen('daytime')
- || $self->ut_phonen('night')
- || $self->ut_phonen('fax')
- ;
- return $error if $error;
-
- return "Unknown agent"
- unless qsearchs('agent',{'agentnum'=>$self->agentnum});
-
- return "Unknown referral"
- unless qsearchs('part_referral',{'refnum'=>$self->refnum});
-
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
- $self->setfield('last',$1);
-
- $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
- $self->first($1);
-
- if ( $self->ss eq '' ) {
- $self->ss('');
- } else {
- my $ss = $self->ss;
- $ss =~ s/\D//g;
- $ss =~ /^(\d{3})(\d{2})(\d{4})$/
- or return "Illegal social security number";
- $self->ss("$1-$2-$3");
- }
-
- return "Unknown state/county/country"
- unless qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- } );
-
- #int'l zips?
- $self->zip =~ /^(\d{5}(-\d{4})?)$/ or return "Illegal zip";
- $self->zip($1);
-
- #int'l countries!
- $self->country =~ /^(US)$/ or return "Illegal country";
- $self->country($1);
-
- $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $self->payby($1);
-
- if ( $self->payby eq 'CARD' ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
- or return "Illegal credit card number";
- $payinfo = $1;
- $self->payinfo($payinfo);
- validate($payinfo) or return "Illegal credit card number";
- my $type = cardtype($payinfo);
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
-
- } elsif ( $self->payby eq 'BILL' ) {
-
- $self->payinfo =~ /^([\w \-]*)$/ or return "Illegal P.O. number";
- $self->payinfo($1);
-
- } elsif ( $self->payby eq 'COMP' ) {
-
- $self->payinfo =~ /^(\w{2,8})$/ or return "Illegal comp account issuer";
- $self->payinfo($1);
-
- }
-
- if ( $self->paydate eq '' ) {
- return "Expriation date required" unless $self->payby eq 'BILL';
- $self->paydate('');
- } else {
- $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
- or return "Illegal expiration date";
- if ( length($2) == 4 ) {
- $self->paydate("$2-$1-01");
- } elsif ( $2 > 97 ) { #should pry change to check for "this year"
- $self->paydate("19$2-$1-01");
- } else {
- $self->paydate("20$2-$1-01");
- }
- }
-
- if ( $self->payname eq '' ) {
- $self->payname( $self->first. " ". $self->getfield('last') );
- } else {
- $self->payname =~ /^([\w \,\.\-\']+)$/
- or return "Illegal billing name";
- $self->payname($1);
- }
-
- $self->tax =~ /^(Y?)$/ or return "Illegal tax";
- $self->tax($1);
-
- $self->otaker(getotaker);
-
- ''; #no error
-}
-
-=item all_pkgs
-
-Returns all packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub all_pkgs {
- my($self)=@_;
- qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
-}
-
-=item ncancelled_pkgs
-
-Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub ncancelled_pkgs {
- my($self)=@_;
- qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => '',
- });
-}
-
-=item bill OPTIONS
-
-Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
-conjunction with the collect method.
-
-The only currently available option is `time', which bills the customer as if
-it were that time. It is specified as a UNIX timestamp; see
-L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub bill {
- my($self,%options)=@_;
- my($time) = $options{'time'} || $^T;
-
- my($error);
-
- #put below somehow?
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- # find the packages which are due for billing, find out how much they are
- # & generate invoice database.
-
- my($total_setup,$total_recur)=(0,0);
-
- my(@cust_bill_pkg);
-
- my($cust_pkg);
- foreach $cust_pkg (
- qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
- ) {
-
- bless($cust_pkg,"FS::cust_pkg");
-
- next if ( $cust_pkg->getfield('cancel') );
-
- #? to avoid use of uninitialized value errors... ?
- $cust_pkg->setfield('bill', '')
- unless defined($cust_pkg->bill);
-
- my($part_pkg)=
- qsearchs('part_pkg',{'pkgpart'=> $cust_pkg->pkgpart } );
-
- #so we don't modify cust_pkg record unnecessarily
- my($cust_pkg_mod_flag)=0;
- my(%hash)=$cust_pkg->hash;
- my($old_cust_pkg)=create FS::cust_pkg(\%hash);
-
- # bill setup
- my($setup)=0;
- unless ( $cust_pkg->setup ) {
- my($setup_prog)=$part_pkg->getfield('setup');
- my($cpt) = new Safe;
- #$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
- $setup = $cpt->reval($setup_prog);
- unless ( defined($setup) ) {
- warn "Error reval-ing part_pkg->setup pkgpart ",
- $part_pkg->pkgpart, ": $@";
- } else {
- $cust_pkg->setfield('setup',$time);
- $cust_pkg_mod_flag=1;
- }
- }
-
- #bill recurring fee
- my($recur)=0;
- my($sdate);
- if ( $part_pkg->getfield('freq') > 0 &&
- ! $cust_pkg->getfield('susp') &&
- ( $cust_pkg->getfield('bill') || 0 ) < $time
- ) {
- my($recur_prog)=$part_pkg->getfield('recur');
- my($cpt) = new Safe;
- #$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
- $recur = $cpt->reval($recur_prog);
- unless ( defined($recur) ) {
- warn "Error reval-ing part_pkg->recur pkgpart ",
- $part_pkg->pkgpart, ": $@";
- } else {
- #change this bit to use Date::Manip?
- #$sdate=$cust_pkg->bill || time;
- #$sdate=$cust_pkg->bill || $time;
- $sdate=$cust_pkg->bill || $cust_pkg->setup || $time;
- my($sec,$min,$hour,$mday,$mon,$year)=
- (localtime($sdate) )[0,1,2,3,4,5];
- $mon += $part_pkg->getfield('freq');
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- $cust_pkg->setfield('bill',timelocal($sec,$min,$hour,$mday,$mon,$year));
- $cust_pkg_mod_flag=1;
- }
- }
-
- warn "setup is undefinded" unless defined($setup);
- warn "recur is undefinded" unless defined($recur);
- warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
-
- if ($cust_pkg_mod_flag) {
- $error=$cust_pkg->replace($old_cust_pkg);
- if ( $error ) {
- warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
- } else {
- #just in case
- $setup=sprintf("%.2f",$setup);
- $recur=sprintf("%.2f",$recur);
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'recur' => $recur,
- 'sdate' => $sdate,
- 'edate' => $cust_pkg->bill,
- });
- push @cust_bill_pkg, $cust_bill_pkg;
- $total_setup += $setup;
- $total_recur += $recur;
- }
- }
-
- }
-
- my($charged)=sprintf("%.2f",$total_setup + $total_recur);
-
- return '' if scalar(@cust_bill_pkg) == 0;
-
- unless ( $self->getfield('tax') eq 'Y' ||
- $self->getfield('tax') eq 'y' ||
- $self->getfield('payby') eq 'COMP'
- ) {
- my($cust_main_county) = qsearchs('cust_main_county',{
- 'county' => $self->getfield('county'),
- 'state' => $self->getfield('state'),
- } );
- my($tax) = sprintf("%.2f",
- $charged * ( $cust_main_county->getfield('tax') / 100 )
- );
- $charged = sprintf("%.2f",$charged+$tax);
-
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- });
- push @cust_bill_pkg, $cust_bill_pkg;
- }
-
- my($cust_bill) = create FS::cust_bill ( {
- 'custnum' => $self->getfield('custnum'),
- '_date' => $time,
- 'charged' => $charged,
- } );
- $error=$cust_bill->insert;
- #shouldn't happen, but how else to handle this? (wrap me in eval, to catch
- # fatal errors)
- die "Error creating cust_bill record: $error!\n",
- "Check updated but unbilled packages for customer", $self->custnum, "\n"
- if $error;
-
- my($invnum)=$cust_bill->invnum;
- my($cust_bill_pkg);
- foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->setfield('invnum',$invnum);
- $error=$cust_bill_pkg->insert;
- #shouldn't happen, but how else tohandle this?
- die "Error creating cust_bill_pkg record: $error!\n",
- "Check incomplete invoice ", $invnum, "\n"
- if $error;
- }
-
- ''; #no error
-}
-
-=item collect OPTIONS
-
-(Attempt to) collect money for this customer's outstanding invoices (see
-L<FS::cust_bill>). Usually used after the bill method.
-
-Depending on the value of `payby', this may print an invoice (`BILL'), charge
-a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
-
-If there is an error, returns the error, otherwise returns false.
-
-Currently available options are:
-
-invoice_time - Use this time when deciding when to print invoices and
-late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
-for conversion functions.
-
-batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
-default, cards are processed immediately, which will generate an error if
-CyberCash is not installed.
-
-report_badcard - Set this true if you want bad card transactions to
-return an error. By default, they don't.
-
-=cut
-
-sub collect {
- my($self,%options)=@_;
- my($invoice_time) = $options{'invoice_time'} || $^T;
-
- my($total_owed) = $self->balance;
- return '' unless $total_owed > 0; #redundant?????
-
- #put below somehow?
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- foreach my $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
-
- #this has to be before next's
- my($amount) = sprintf("%.2f", $total_owed < $cust_bill->owed
- ? $total_owed
- : $cust_bill->owed
- );
- $total_owed = sprintf("%.2f",$total_owed-$amount);
-
- next unless $cust_bill->owed > 0;
-
- next if qsearchs('cust_pay_batch',{'invnum'=> $cust_bill->invnum });
-
- #warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)";
-
- next unless $amount > 0;
-
- if ( $self->getfield('payby') eq 'BILL' ) {
-
- #30 days 2592000
- my($since)=$invoice_time - ( $cust_bill->_date || 0 );
- #warn "$invoice_time ", $cust_bill->_date, " $since";
- if ( $since >= 0 #don't print future invoices
- && ( $cust_bill->printed * 2592000 ) <= $since
- ) {
-
- 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(%hash)=$cust_bill->hash;
- $hash{'printed'}++;
- my($new_cust_bill)=create FS::cust_bill(\%hash);
- my($error)=$new_cust_bill->replace($cust_bill);
- if ( $error ) {
- warn "Error updating $cust_bill->printed: $error";
- }
-
- }
-
- } elsif ( $self->getfield('payby') eq 'COMP' ) {
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'COMP',
- 'payinfo' => $self->getfield('payinfo'),
- 'paybatch' => ''
- } );
- my($error)=$cust_pay->insert;
- return 'Error COMPing invnum #' . $cust_bill->getfield('invnum') .
- ':' . $error if $error;
- } elsif ( $self->getfield('payby') eq 'CARD' ) {
-
- if ( $options{'batch_card'} ne 'yes' ) {
-
- return "Real time card processing not enabled!" unless $processor;
-
- if ( $processor =~ /cybercash/ ) {
-
- #fix exp. date for cybercash
- $self->getfield('paydate') =~ /^(\d+)\/\d*(\d{2})$/;
- my($exp)="$1/$2";
-
- my($paybatch)= $cust_bill->getfield('invnum') .
- '-' . time2str("%y%m%d%H%M%S",time);
-
- my($payname)= $self->getfield('payname') ||
- $self->getfield('first') . ' ' .$self->getfield('last');
-
- my($address)= $self->getfield('address1');
- $address .= ", " . $self->getfield('address2')
- if $self->getfield('address2');
-
- my($country) = $self->getfield('country') eq 'US' ?
- 'USA' : $self->getfield('country');
-
- my(@full_xaction)=($xaction,
- 'Order-ID' => $paybatch,
- 'Amount' => "usd $amount",
- 'Card-Number' => $self->getfield('payinfo'),
- 'Card-Name' => $payname,
- 'Card-Address' => $address,
- 'Card-City' => $self->getfield('city'),
- 'Card-State' => $self->getfield('state'),
- 'Card-Zip' => $self->getfield('zip'),
- 'Card-Country' => $country,
- 'Card-Exp' => $exp,
- );
-
- my(%result);
- if ( $processor eq 'cybercash2' ) {
- $^W=0; #CCLib isn't -w safe, ugh!
- %result = &CCLib::sendmserver(@full_xaction);
- $^W=1;
- } elsif ( $processor eq 'cybercash3.2' ) {
- %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
- } else {
- return "Unkonwn real-time processor $processor\n";
- }
-
- #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
- #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
- if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'CARD',
- 'payinfo' => $self->getfield('payinfo'),
- 'paybatch' => "$processor:$paybatch",
- } );
- my($error)=$cust_pay->insert;
- return 'Error applying payment, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $error if $error;
- } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
- || $options{'report_badcard'} ) {
- return 'Cybercash error, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $result{'MErrMsg'};
- } else {
- return '';
- }
-
- } else {
- return "Unkonwn real-time processor $processor\n";
- }
-
- } else { #batch card
-
-# my($cust_pay_batch) = create FS::cust_pay_batch ( {
- my($cust_pay_batch) = new FS::Record ('cust_pay_batch', {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'custnum' => $self->getfield('custnum'),
- 'last' => $self->getfield('last'),
- 'first' => $self->getfield('first'),
- 'address1' => $self->getfield('address1'),
- 'address2' => $self->getfield('address2'),
- 'city' => $self->getfield('city'),
- 'state' => $self->getfield('state'),
- 'zip' => $self->getfield('zip'),
- 'country' => $self->getfield('country'),
- 'trancode' => 77,
- 'cardnum' => $self->getfield('payinfo'),
- 'exp' => $self->getfield('paydate'),
- 'payname' => $self->getfield('payname'),
- 'amount' => $amount,
- } );
-# my($error)=$cust_pay_batch->insert;
- my($error)=$cust_pay_batch->add;
- return "Error adding to cust_pay_batch: $error" if $error;
-
- }
-
- } else {
- return "Unknown payment type ".$self->getfield('payby');
- }
-
- }
- '';
-
-}
-
-=item total_owed
-
-Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill>).
-
-=cut
-
-sub total_owed {
- my($self) = @_;
- my($total_bill) = 0;
- my($cust_bill);
- foreach $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
- $total_bill += $cust_bill->getfield('owed');
- }
- sprintf("%.2f",$total_bill);
-}
-
-=item total_credited
-
-Returns the total credits (see L<FS::cust_credit>) for this customer.
-
-=cut
-
-sub total_credited {
- my($self) = @_;
- my($total_credit) = 0;
- my($cust_credit);
- foreach $cust_credit ( qsearch('cust_credit', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
- $total_credit += $cust_credit->getfield('credited');
- }
- sprintf("%.2f",$total_credit);
-}
-
-=item balance
-
-Returns the balance for this customer (total owed minus total credited).
-
-=cut
-
-sub balance {
- my($self) = @_;
- sprintf("%.2f",$self->total_bill - $self->total_credit);
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-It doesn't properly override FS::Record yet.
-
-hfields should be removed.
-
-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.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
-L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
-L<FS::cust_main_county>, L<FS::UID>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-28
-
-Changed to standard Business::CreditCard
-no more TableUtil
-EXPORT_OK FS::Record's hfields
-removed unique calls and locking (not needed here now)
-wrapped the (now) optional fields in if statements in sub check (notyetdone!)
-ivan@sisd.com 97-nov-12
-
-updated paydate with SQL-type date info ivan@sisd.com 98-mar-5
-
-Added export of datasrc from UID.pm for Pg6.3
-changed 'day' to 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
-in ->create, s/svc_acct/cust_main/, now it should actually eliminate the
-warnings it was meant to ivan@sisd.com 98-jul-16
-
-don't require a phone number and allow '/' in company names
-ivan@sisd.com 98-jul-18
-
-use ut_ and rewrite &check, &*_pkgs ivan@sisd.com 98-sep-5
-
-pod, merge with FS::Bill (about time!), total_owed, total_credited and balance
-methods, cleaned collect method, source modifications no longer necessary to
-enable cybercash, cybercash v3 support, don't need to import
-FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
-
-=cut
-
-1;
-
-
+++ /dev/null
-package FS::cust_main_county;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields qsearch qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-=head1 NAME
-
-FS::cust_main_county - Object methods for cust_main_county objects
-
-=head1 SYNOPSIS
-
- use FS::cust_main_county;
-
- $record = create FS::cust_main_county \%hash;
- $record = create FS::cust_main_county { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_main_county object represents a tax rate, defined by locale.
-FS::cust_main_county inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item taxnum - primary key (assigned automatically for new tax rates)
-
-=item state
-
-=item county
-
-=item tax - percentage
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_main_county')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main_county',$hashref);
-}
-
-=item insert
-
-Adds this tax rate to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this tax rate from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main_county record!"
- unless $old->table eq "cust_main_county";
- return "Can't change taxnum!"
- unless $old->getfield('taxnum') eq $new->getfield('taxnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid tax rate. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_main_county record!"
- unless $self->table eq "cust_main_county";
- my($recref) = $self->hashref;
-
- $self->ut_numbern('taxnum')
- or $self->ut_text('state')
- or $self->ut_textn('county')
- or $self->ut_float('tax')
- ;
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-A country field (and possibly a currency field) should be added.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-dec-16
-
-Changed check for 'tax' to use the new ut_float subroutine
- bmccane@maxbaud.net 98-apr-3
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_pay;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
-use FS::cust_bill;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_pay - Object methods for cust_pay objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pay;
-
- $record = create FS::cust_pay \%hash;
- $record = create FS::cust_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay object represents a payment. FS::cust_pay inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item paynum - primary key (assigned automatically for new payments)
-
-=item invnum - Invoice (see L<FS::cust_bill>)
-
-=item paid - Amount of this payment
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
-
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
-
-=item paybatch - text field for tracking card processing
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new payment. To add the payment to the databse, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pay')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pay',$hashref);
-
-}
-
-=item insert
-
-Adds this payment to the databse, and updates the invoice (see
-L<FS::cust_bill>).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- my($error);
-
- $error=$self->check;
- return $error if $error;
-
- my($old_cust_bill) = qsearchs('cust_bill', {
- 'invnum' => $self->getfield('invnum')
- } );
- return "Unknown invnum" unless $old_cust_bill;
- my(%hash)=$old_cust_bill->hash;
- $hash{owed} = sprintf("%.2f",$hash{owed} - $self->getfield('paid') );
- my($new_cust_bill) = create FS::cust_bill ( \%hash );
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$new_cust_bill -> replace($old_cust_bill);
- return "Error modifying cust_bill: $error" if $error;
-
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete cust_pay records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub replace {
- return "Can't (yet?) modify cust_pay records!";
-#template code below
-# my($new,$old)=@_;
-# return "(Old) Not a cust_pay record!" unless $old->table eq "cust_pay";
-#
-# $new->check or
-# $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid payment. If there is an error,
-returns the error, otherwise returns false. Called by the insert method.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_pay record!" unless $self->table eq "cust_pay";
- my($recref) = $self->hashref;
-
- $recref->{paynum} =~ /^(\d*)$/ or return "Illegal paynum";
- $recref->{paynum} = $1;
-
- $recref->{invnum} =~ /^(\d+)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
-
- $recref->{paid} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal paid";
- $recref->{paid} = $1;
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
-
- if ( $recref->{payby} eq 'CARD' ) {
-
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
- or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal credit card number";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
- } else {
- $recref->{payinfo}='N/A';
- }
-
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
- }
-
- $recref->{paybatch} =~ /^([\w\-\:]*)$/
- or return "Illegal paybatch";
- $recref->{paybatch} = $1;
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1 - 25 - 29
-
-new api ivan@sisd.com 98-mar-13
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_pkg;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
-
-@ISA = qw(FS::Record Exporter);
-
-=head1 NAME
-
-FS::cust_pkg - Object methods for cust_pkg objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg;
-
- $record = create FS::cust_pkg \%hash;
- $record = create FS::cust_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->cancel;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = FS::cust_pkg::order( $custnum, \@pkgparts );
- $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgnum - primary key (assigned automatically for new billing items)
-
-=item custnum - Customer (see L<FS::cust_main>)
-
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
-
-=item setup - date
-
-=item bill - date
-
-=item susp - date
-
-=item expire - date
-
-=item cancel - date
-
-=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
-
-=back
-
-Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
-see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
-conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Create a new billing item. To add the item to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pkg',$hashref);
-}
-
-=item insert
-
-Adds this billing item to the database ("Orders" the item). If there is an
-error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item 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!";
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
-
-pkgpart may not be changed, but see the order subroutine.
-
-setup and bill are normally updated by calling the bill method of a customer
-object (see L<FS::cust_main>).
-
-suspend is normally updated by the suspend and unsuspend methods.
-
-cancel is normally updated by the cancel method (and also the order subroutine
-in some cases).
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
- return "Can't change pkgnum!"
- if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
- return "Can't (yet?) change pkgpart!"
- if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change otaker!"
- if $old->getfield('otaker') ne $new->getfield('otaker');
- return "Can't change setup once it exists!"
- if $old->getfield('setup') &&
- $old->getfield('setup') != $new->getfield('setup');
- #some logic for bill, susp, cancel?
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid billing item. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
- my($recref) = $self->hashref;
-
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum}=$1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart}=$1;
- return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
-
- $recref->{otaker} ||= &getotaker;
- $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
- $recref->{otaker}=$1;
-
- $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
- $recref->{setup}=$1;
-
- $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
- $recref->{bill}=$1;
-
- $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
- $recref->{susp}=$1;
-
- $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
- $recref->{cancel}=$1;
-
- ''; #no error
-}
-
-=item cancel
-
-Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
-in this package, then cancels the package itself (sets the cancel field to
-now).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub cancel {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
- ) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
- require "FS/$svcdb.pm";
-
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
- if ($svc) {
- bless($svc,"FS::$svcdb");
- $error = $svc->cancel;
- return "Error cancelling service: $error" if $error;
- $error = $svc->delete;
- return "Error deleting service: $error" if $error;
- }
-
- bless($cust_svc,"FS::cust_svc");
- $error = $cust_svc->delete;
- return "Error deleting cust_svc: $error" if $error;
-
- }
-
- unless ( $self->getfield('cancel') ) {
- my(%hash) = $self->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
- return $error if $error;
- }
-
- ''; #no errors
-}
-
-=item suspend
-
-Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
-package, then suspends the package itself (sets the susp field to now).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub suspend {
- my($self)=@_;
- my($error);
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
- ) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
-
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
- require "FS/$svcdb.pm";
-
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
-
- if ($svc) {
- bless($svc,"FS::$svcdb");
- $error = $svc->suspend;
- return $error if $error;
- }
-
- }
-
- unless ( $self->getfield('susp') ) {
- my(%hash) = $self->hash;
- $hash{'susp'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
- return $error if $error;
- }
-
- ''; #no errors
-}
-
-=item unsuspend
-
-Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
-package, then unsuspends the package itself (clears the susp field).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub unsuspend {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
- ) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
-
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
- require "FS/$svcdb.pm";
-
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
- if ($svc) {
- bless($svc,"FS::$svcdb");
- $error = $svc->unsuspend;
- return $error if $error;
- }
-
- }
-
- unless ( ! $self->getfield('susp') ) {
- my(%hash) = $self->hash;
- $hash{'susp'}='';
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
- return $error if $error;
- }
-
- ''; #no errors
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
-
-CUSTNUM is a customer (see L<FS::cust_main>)
-
-PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
-L<FS::part_pkg>) to order for this customer. Duplicates are of course
-permitted.
-
-REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
-remove for this customer. The services (see L<FS::cust_svc>) are moved to the
-new billing items. An error is returned if this is not possible (see
-L<FS::pkg_svc>).
-
-=cut
-
-sub order {
- my($custnum,$pkgparts,$remove_pkgnums)=@_;
-
- my(%part_pkg);
- # 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($type_pkgs);
- foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
- my($pkgpart)=$type_pkgs->pkgpart;
- $part_pkg{$pkgpart}++;
- }
- #
-
- my(%svcnum);
- # generate %svcnum
- # for those packages being removed:
- #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
- # objects (table eq 'cust_svc')
- my($pkgnum);
- foreach $pkgnum ( @{$remove_pkgnums} ) {
- my($cust_svc);
- foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
- push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
- }
- }
-
- my(@cust_svc);
- #generate @cust_svc
- # for those packages the customer is purchasing:
- # @{$pkgparts} is a list of said packages, by pkgpart
- # @cust_svc is a corresponding list of lists of FS::Record objects
- my($pkgpart);
- foreach $pkgpart ( @{$pkgparts} ) {
- return "Customer not permitted to purchase pkgpart $pkgpart!"
- unless $part_pkg{$pkgpart};
- push @cust_svc, [
- map {
- ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
- } (split(/,/,
- qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
- ))
- ];
- }
-
- #check for leftover services
- foreach (keys %svcnum) {
- next unless @{ $svcnum{$_} };
- return "Leftover services!";
- }
-
- #no leftover services, let's make changes.
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- #first cancel old packages
-# my($pkgnum);
- foreach $pkgnum ( @{$remove_pkgnums} ) {
- my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- return "Package $pkgnum not found to remove!" unless $old;
- my(%hash) = $old->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- my($error)=$new->replace($old);
- return $error if $error;
- }
-
- #now add new packages, changing cust_svc records if necessary
-# my($pkgpart);
- while ($pkgpart=shift @{$pkgparts} ) {
-
- my($new) = create FS::cust_pkg ( {
- 'custnum' => $custnum,
- 'pkgpart' => $pkgpart,
- } );
- my($error) = $new->insert;
- return $error if $error;
- my($pkgnum)=$new->getfield('pkgnum');
-
- my($cust_svc);
- foreach $cust_svc ( @{ shift @cust_svc } ) {
- my(%hash) = $cust_svc->hash;
- $hash{'pkgnum'}=$pkgnum;
- my($new) = create FS::cust_svc ( \%hash );
- my($error)=$new->replace($cust_svc);
- return $error if $error;
- }
- }
-
- ''; #no errors
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
-
-In sub order, the @pkgparts array (passed by reference) is clobbered.
-
-Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
-method to pass dates to the recur_prog expression, it should do so.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
-, L<FS::pkg_svc>, schema.html from the base documentation
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1 - 21
-
-fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_refund;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
-use FS::UID qw(getotaker);
-use FS::cust_credit;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_refund - Object method for cust_refund objects
-
-=head1 SYNOPSIS
-
- use FS::cust_refund;
-
- $record = create FS::cust_refund \%hash;
- $record = create FS::cust_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_refund represents a refund. FS::cust_refund inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item refundnum - primary key (assigned automatically for new refunds)
-
-=item crednum - Credit (see L<FS::cust_credit>)
-
-=item refund - Amount of the refund
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
-
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
-
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new refund. To add the refund to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_refund')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_refund',$hashref);
-
-}
-
-=item insert
-
-Adds this refund to the database, and updates the credit (see
-L<FS::cust_credit>).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- my($error);
-
- $error=$self->check;
- return $error if $error;
-
- my($old_cust_credit) = qsearchs('cust_credit', {
- 'crednum' => $self->getfield('crednum')
- } );
- return "Unknown crednum" unless $old_cust_credit;
- my(%hash)=$old_cust_credit->hash;
- $hash{credited} = sprintf("%.2f",$hash{credited} - $self->getfield('refund') );
- my($new_cust_credit) = create FS::cust_credit ( \%hash );
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$new_cust_credit -> replace($old_cust_credit);
- return "Error modifying cust_credit: $error" if $error;
-
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete cust_refund records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub replace {
- return "Can't (yet?) modify cust_refund records!";
-#template code below
-# my($new,$old)=@_;
-# return "(Old) Not a cust_refund record!" unless $old->table eq "cust_refund";
-#
-# $new->check or
-# $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid refund. If there is an error,
-returns the error, otherwise returns false. Called by the insert method.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_refund record!" unless $self->table eq "cust_refund";
-
- my $error =
- $self->ut_number('refundnum')
- || $self->ut_number('crednum')
- || $self->ut_money('amount')
- || $self->ut_numbern('_date')
- ;
- return $error if $error;
-
- my($recref) = $self->hashref;
-
- $recref->{_date} ||= time;
-
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
-
- if ( $recref->{payby} eq 'CARD' ) {
-
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
- or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal (checksum) credit card number (payinfo)";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
- } else {
- $recref->{payinfo}='N/A';
- }
-
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
- }
-
- $self->otaker(getotaker);
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_credit>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 98-mar-18
-
-->create had wrong tablename ivan@sisd.com 98-jun-16
-(finish me!)
-
-pod and finish up ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_svc;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-
-=head1 NAME
-
-FS::cust_svc - Object method for cust_svc objects
-
-=head1 SYNOPSIS
-
- use FS::cust_svc;
-
- $record = create FS::cust_svc \%hash
- $record = create FS::cust_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatically for new services)
-
-=item pkgnum - Package (see L<FS::cust_pkg>)
-
-=item svcpart - Service definition (see L<FS::part_svc>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new service. To add the refund to the database, see L<"insert">.
-Services are normally created by creating FS::svc_ objects (see
-L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others).
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_svc',$hashref);
-}
-
-=item insert
-
-Adds this service to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this service from the database. If there is an error, returns the
-error, otherwise returns false.
-
-Called by the cancel method of the package (see L<FS::cust_pkg>).
-
-=cut
-
-sub delete {
- my($self)=@_;
- # anything else here?
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_svc record!" unless $old->table eq "cust_svc";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service. If there is an error,
-returns the error, otehrwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_svc record!" unless $self->table eq "cust_svc";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum}=$1;
-
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
- return "Unknown pkgnum" unless
- ! $recref->{pkgnum} ||
- qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}});
-
- $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart";
- $recref->{svcpart}=$1;
- return "Unknown svcpart" unless
- qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}});
-
- ''; #no error
-}
-
-=back
-
-=head1 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).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
-schema.html from the base documentation
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-10,14
-
-no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use Carp;
-use FreezeThaw qw(freeze thaw cmpStr);
-use FS::dbdef_table;
-use FS::dbdef_unique;
-use FS::dbdef_index;
-use FS::dbdef_column;
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef - Database objects
-
-=head1 SYNOPSIS
-
- use FS::dbdef;
-
- $dbdef = new FS::dbdef (@dbdef_table_objects);
- $dbdef = load FS::dbdef "filename";
-
- $dbdef->save("filename");
-
- $dbdef->addtable($dbdef_table_object);
-
- @table_names = $dbdef->tables;
-
- $FS_dbdef_table_object = $dbdef->table;
-
-=head1 DESCRIPTION
-
-FS::dbdef objects are collections of FS::dbdef_table objects and represnt
-a database (a collection of tables).
-
-=head1 METHODS
-
-=over 4
-
-=item new TABLE, TABLE, ...
-
-Creates a new FS::dbdef object
-
-=cut
-
-sub new {
- my($proto,@tables)=@_;
- my(%tables)=map { $_->name, $_ } @tables; #check for duplicates?
-
- my($class) = ref($proto) || $proto;
- my($self) = {
- 'tables' => \%tables,
- };
-
- bless ($self, $class);
-
-}
-
-=item load FILENAME
-
-Loads an FS::dbdef object from a file.
-
-=cut
-
-sub load {
- my($proto,$file)=@_; #use $proto ?
- open(FILE,"<$file") or die "Can't open $file: $!";
- my($string)=join('',<FILE>); #can $string have newlines? pry not?
- close FILE or die "Can't close $file: $!";
- my($self)=thaw $string;
- #no bless needed?
- $self;
-}
-
-=item save FILENAME
-
-Saves an FS::dbdef object to a file.
-
-=cut
-
-sub save {
- my($self,$file)=@_;
- my($string)=freeze $self;
- open(FILE,">$file") or die "Can't open $file: $!";
- print FILE $string;
- close FILE or die "Can't close file: $!";
- my($check_self)=thaw $string;
- die "Verify error: Can't freeze and thaw dbdef $self"
- if (cmpStr($self,$check_self));
-}
-
-=item addtable TABLE
-
-Adds this FS::dbdef_table object.
-
-=cut
-
-sub addtable {
- my($self,$table)=@_;
- ${$self->{'tables'}}{$table->name}=$table; #check for dupliates?
-}
-
-=item tables
-
-Returns the names of all tables.
-
-=cut
-
-sub tables {
- my($self)=@_;
- keys %{$self->{'tables'}};
-}
-
-=item table TABLENAME
-
-Returns the named FS::dbdef_table object.
-
-=cut
-
-sub table {
- my($self,$table)=@_;
- $self->{'tables'}->{$table};
-}
-
-=head1 BUGS
-
-Each FS::dbdef object should have a name which corresponds to its name within
-the SQL database engine.
-
-=head1 SEE ALSO
-
-L<FS::dbdef_table>, L<FS::Record>,
-
-=head1 HISTORY
-
-beginning of abstraction into a class (not really)
-
-ivan@sisd.com 97-dec-4
-
-added primary_key
-ivan@sisd.com 98-jan-20
-
-added datatype (very kludgy and needs to be cleaned)
-ivan@sisd.com 98-feb-21
-
-perltrap (sigh) masked by mysql 3.20->3,21 ivan@sisd.com 98-mar-2
-
-Change 'type' to 'atype' in agent_type
-Changed attributes to special words which are changed in fs-setup
- ie. double(10,2) <=> MONEYTYPE
-Changed order of some of the field definitions because Pg6.3 is picky
-Changed 'day' to 'daytime' in cust_main
-Changed type of tax from tinyint to real
-Change 'password' to '_password' in svc_acct
-Pg6.3 does not allow 'field char(x) NULL'
- bmccane@maxbaud.net 98-apr-3
-
-rewrite: now properly OO. See also FS::dbdef_{table,column,unique,index}
-
-ivan@sisd.com 98-apr-17
-
-gained some extra functions ivan@sisd.com 98-may-11
-
-now knows how to Freeze and Thaw itself ivan@sisd.com 98-jun-2
-
-pod ivan@sisd.com 98-sep-23
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_colgroup;
-
-use strict;
-use vars qw(@ISA);
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef_colgroup - Column group objects
-
-=head1 SYNOPSIS
-
- use FS::dbdef_colgroup;
-
- $colgroup = new FS::dbdef_colgroup ( $lol );
- $colgroup = new FS::dbdef_colgroup (
- [
- [ 'single_column' ],
- [ 'multiple_columns', 'another_column', ],
- ]
- );
-
- @sql_lists = $colgroup->sql_list;
-
- @singles = $colgroup->singles;
-
-=head1 DESCRIPTION
-
-FS::dbdef_colgroup objects represent sets of sets of columns.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new FS::dbdef_colgroup object.
-
-=cut
-
-sub new {
- my($proto, $lol) = @_;
-
- my $class = ref($proto) || $proto;
- my $self = {
- 'lol' => $lol,
- };
-
- bless ($self, $class);
-
-}
-
-=item sql_list
-
-Returns a flat list of comma-separated values, for SQL statements.
-
-=cut
-
-sub sql_list { #returns a flat list of comman-separates lists (for sql)
- my($self)=@_;
- grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
-}
-
-=item singles
-
-Returns a flat list of all single item lists.
-
-=cut
-
-sub singles { #returns single-field groups as a flat list
- my($self)=@_;
- #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
- map {
- ${$_}[0] =~ /^(\w+)$/
- #aah!
- or die "Illegal column ", ${$_}[0], " in colgroup!";
- $1;
- } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::dbdef_table>, L<FS::dbdef_unique>, L<FS::dbdef_index>,
-L<FS::dbdef_column>, L<FS::dbdef>, L<perldsc>
-
-=head1 HISTORY
-
-class for dealing with groups of groups of columns (used as a base class by
-FS::dbdef_{unique,index} )
-
-ivan@sisd.com 98-apr-19
-
-added singles, fixed sql_list to skip empty lists ivan@sisd.com 98-jun-2
-
-untaint things we're returning in sub singels ivan@sisd.com 98-jun-4
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_column;
-
-use strict;
-#use Carp;
-use Exporter;
-use vars qw(@ISA);
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef_column - Column object
-
-=head1 SYNOPSIS
-
- use FS::dbdef_column;
-
- $column_object = new FS::dbdef_column ( $name, $sql_type, '' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, '', $length );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL', $length );
-
- $name = $column_object->name;
- $column_object->name ( 'name' );
-
- $name = $column_object->type;
- $column_object->name ( 'sql_type' );
-
- $name = $column_object->null;
- $column_object->name ( 'NOT NULL' );
-
- $name = $column_object->length;
- $column_object->name ( $length );
-
- $sql_line = $column->line;
- $sql_line = $column->line $datasrc;
-
-=head1 DESCRIPTION
-
-FS::dbdef::column objects represend columns in tables (see L<FS::dbdef_table>).
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new FS::dbdef_column object.
-
-=cut
-
-sub new {
- my($proto,$name,$type,$null,$length)=@_;
-
- #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
-
- $null =~ s/^NOT NULL$//i;
-
- my $class = ref($proto) || $proto;
- my $self = {
- 'name' => $name,
- 'type' => $type,
- 'null' => $null,
- 'length' => $length,
- };
-
- bless ($self, $class);
-
-}
-
-=item name
-
-Returns or sets the column name.
-
-=cut
-
-sub name {
- my($self,$value)=@_;
- if ( defined($value) ) {
- #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
- $self->{'name'} = $value;
- } else {
- $self->{'name'};
- }
-}
-
-=item type
-
-Returns or sets the column type.
-
-=cut
-
-sub type {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{'type'} = $value;
- } else {
- $self->{'type'};
- }
-}
-
-=item null
-
-Returns or sets the column null flag.
-
-=cut
-
-sub null {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $value =~ s/^NOT NULL$//i;
- $self->{'null'} = $value;
- } else {
- $self->{'null'};
- }
-}
-
-=item type
-
-Returns or sets the column length.
-
-=cut
-
-sub length {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{'length'} = $value;
- } else {
- $self->{'length'};
- }
-}
-
-=item line [ $datasrc ]
-
-Returns an SQL column definition.
-
-If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
-syntax. Non-standard syntax for other engines (if applicable) may also be
-supported in the future.
-
-=cut
-
-sub line {
- my($self,$datasrc)=@_;
- my($null)=$self->null;
- $null ||= "NOT NULL" if $datasrc =~ /mysql/; #yucky mysql hack
- join(' ',
- $self->name,
- $self->type. ( $self->length ? '('.$self->length.')' : '' ),
- $null,
- );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::dbdef_table>, L<FS::dbdef>, L<DBI>
-
-=head1 HISTORY
-
-class for dealing with column definitions
-
-ivan@sisd.com 98-apr-17
-
-now methods can be used to get or set data ivan@sisd.com 98-may-11
-
-mySQL-specific hack for null (what should be default?) ivan@sisd.com 98-jun-2
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_index;
-
-use strict;
-use vars qw(@ISA);
-use FS::dbdef_colgroup;
-
-@ISA=qw(FS::dbdef_colgroup);
-
-=head1 NAME
-
-FS::dbdef_unique.pm - Index object
-
-=head1 SYNOPSIS
-
- use FS::dbdef_index;
-
- # see FS::dbdef_colgroup methods
-
-=head1 DESCRIPTION
-
-FS::dbdef_unique objects represent the (non-unique) indices of a table
-(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
-
-=head1 BUGS
-
-Is this empty subclass needed?
-
-=head1 SEE ALSO
-
-L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record>
-
-=head1 HISTORY
-
-class for dealing with index definitions
-
-ivan@sisd.com 98-apr-19
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_table;
-
-use strict;
-#use Carp;
-use Exporter;
-use vars qw(@ISA);
-use FS::dbdef_column;
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef_table - Table objects
-
-=head1 SYNOPSIS
-
- use FS::dbdef_table;
-
- $dbdef_table = new FS::dbdef_table (
- "table_name",
- "primary_key",
- $FS_dbdef_unique_object,
- $FS_dbdef_index_object,
- @FS_dbdef_column_objects,
- );
-
- $dbdef_table->addcolumn ( $FS_dbdef_column_object );
-
- $table_name = $dbdef_table->name;
- $dbdef_table->name ("table_name");
-
- $table_name = $dbdef_table->primary_keye;
- $dbdef_table->primary_key ("primary_key");
-
- $FS_dbdef_unique_object = $dbdef_table->unique;
- $dbdef_table->unique ( $FS_dbdef_unique_object );
-
- $FS_dbdef_index_object = $dbdef_table->index;
- $dbdef_table->index ( $FS_dbdef_index_object );
-
- @column_names = $dbdef->columns;
-
- $FS_dbdef_column_object = $dbdef->column;
-
- @sql_statements = $dbdef->sql_create_table;
- @sql_statements = $dbdef->sql_create_table $datasrc;
-
-=head1 DESCRIPTION
-
-FS::dbdef_table objects represent a single database table.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new FS::dbdef_table object.
-
-=cut
-
-sub new {
- my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
-
- my(%columns) = map { $_->name, $_ } @columns;
-
- #check $primary_key, $unique and $index to make sure they are $columns ?
- # (and sanity check?)
-
- my $class = ref($proto) || $proto;
- my $self = {
- 'name' => $name,
- 'primary_key' => $primary_key,
- 'unique' => $unique,
- 'index' => $index,
- 'columns' => \%columns,
- };
-
- bless ($self, $class);
-
-}
-
-=item addcolumn
-
-Adds this FS::dbdef_column object.
-
-=cut
-
-sub addcolumn {
- my($self,$column)=@_;
- ${$self->{'columns'}}{$column->name}=$column; #sanity check?
-}
-
-=item name
-
-Returns or sets the table name.
-
-=cut
-
-sub name {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{name} = $value;
- } else {
- $self->{name};
- }
-}
-
-=item primary_key
-
-Returns or sets the primary key.
-
-=cut
-
-sub primary_key {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{primary_key} = $value;
- } else {
- #$self->{primary_key};
- #hmm. maybe should untaint the entire structure when it comes off disk
- # cause if you don't trust that, ?
- $self->{primary_key} =~ /^(\w*)$/
- #aah!
- or die "Illegal primary key ", $self->{primary_key}, " in dbdef!\n";
- $1;
- }
-}
-
-=item unique
-
-Returns or sets the FS::dbdef_unique object.
-
-=cut
-
-sub unique {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{unique} = $value;
- } else {
- $self->{unique};
- }
-}
-
-=item index
-
-Returns or sets the FS::dbdef_index object.
-
-=cut
-
-sub index {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{'index'} = $value;
- } else {
- $self->{'index'};
- }
-}
-
-=item columns
-
-Returns a list consisting of the names of all columns.
-
-=cut
-
-sub columns {
- my($self)=@_;
- keys %{$self->{'columns'}};
-}
-
-=item column "column"
-
-Returns the column object (see L<FS::dbdef_column>) for "column".
-
-=cut
-
-sub column {
- my($self,$column)=@_;
- $self->{'columns'}->{$column};
-}
-
-=item sql_create_table [ $datasrc ]
-
-Returns an array of SQL statments to create this table.
-
-If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
-syntax. Non-standard syntax for other engines (if applicable) may also be
-supported in the future.
-
-=cut
-
-sub sql_create_table {
- my($self,$datasrc)=@_;
-
- my(@columns)=map { $self->column($_)->line($datasrc) } $self->columns;
- push @columns, "PRIMARY KEY (". $self->primary_key. ")"
- if $self->primary_key;
- if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
- push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
- push @columns, map "INDEX ($_)", $self->index->sql_list;
- }
-
- "CREATE TABLE ". $self->name. " ( ". join(", ", @columns). " )",
- ( map {
- my($index) = $_ . "_index";
- $index =~ s/,\s*/_/g;
- "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)"
- } $self->unique->sql_list ),
- ( map {
- my($index) = $_ . "_index";
- $index =~ s/,\s*/_/g;
- "CREATE INDEX $index ON ". $self->name. " ($_)"
- } $self->index->sql_list ),
- ;
-
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::dbdef>, L<FS::dbdef_unique>, L<FS::dbdef_index>, L<FS::dbdef_unique>,
-L<DBI>
-
-=head1 HISTORY
-
-class for dealing with table definitions
-
-ivan@sisd.com 98-apr-18
-
-gained extra functions (should %columns be an IxHash?)
-ivan@sisd.com 98-may-11
-
-sql_create_table returns a list of statments, not just one, and now it
-does indices (plus mysql hack) ivan@sisd.com 98-jun-2
-
-untaint primary_key... hmm. is this a hack around a bigger problem?
-looks like, did the same thing singles in colgroup!
-ivan@sisd.com 98-jun-4
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_unique;
-
-use strict;
-use vars qw(@ISA);
-use FS::dbdef_colgroup;
-
-@ISA=qw(FS::dbdef_colgroup);
-
-=head1 NAME
-
-FS::dbdef_unique.pm - Unique object
-
-=head1 SYNOPSIS
-
- use FS::dbdef_unique;
-
- # see FS::dbdef_colgroup methods
-
-=head1 DESCRIPTION
-
-FS::dbdef_unique objects represent the unique indices of a database table
-(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
-
-=head1 BUGS
-
-Is this empty subclass needed?
-
-=head1 SEE ALSO
-
-L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record>
-
-=head1 HISTORY
-
-class for dealing with unique definitions
-
-ivan@sisd.com 98-apr-19
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
-
+++ /dev/null
-package FS::part_pkg;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields fields);
-
-=head1 NAME
-
-FS::part_pkg - Object methods for part_pkg objects
-
-=head1 SYNOPSIS
-
- use FS::part_pkg;
-
- $record = create FS::part_pkg \%hash
- $record = create FS::part_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg represents a billing item definition. FS::part_pkg inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgpart - primary key (assigned automatically for new billing item definitions)
-
-=item pkg - Text name of this billing item definition (customer-viewable)
-
-=item comment - Text name of this billing item definition (non-customer-viewable)
-
-=item setup - Setup fee
-
-=item freq - Frequency of recurring fee
-
-=item recur - Recurring fee
-
-=back
-
-setup and recur are evaluated as Safe perl expressions. You can use numbers
-just as you would normally. More advanced semantics are not yet defined.
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new billing item definition. To add the billing item definition to
-the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_pkg',$hashref);
-}
-
-=item insert
-
-Adds this billing item definition to the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete package definitions.";
-# maybe check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a part_pkg record!" unless $old->table eq "part_pkg";
- return "Can't change pkgpart!"
- unless $old->getfield('pkgpart') eq $new->getfield('pkgpart');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid billing item definition. If
-there is an error, returns the error, otherwise returns false. Called by the
-insert and replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a part_pkg record!" unless $self->table eq "part_pkg";
-
- $self->ut_numbern('pkgpart')
- or $self->ut_text('pkg')
- or $self->ut_text('comment')
- or $self->ut_anything('setup')
- or $self->ut_number('freq')
- or $self->ut_anything('recur')
- ;
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The delete method is unimplemented.
-
-setup and recur semantics are not yet defined (and are implemented in
-FS::cust_bill. hmm.).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
-schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 97-dec-5
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::part_referral;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::part_referral - Object methods for part_referral objects
-
-=head1 SYNOPSIS
-
- use FS::part_referral;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_referral represents a referral - where a customer heard of your
-services. This can be used to track the effectiveness of a particular piece of
-advertising, for example. FS::part_referral inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item refnum - primary key (assigned automatically for new referrals)
-
-=item referral - Text name of this referral
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new referral. To add the referral to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_referral')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_referral',$hashref);
-}
-
-=item insert
-
-Adds this referral to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't (yet?) delete part_referral records";
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an part_referral record!"
- unless $old->table eq "part_referral";
- return "Can't change refnum!"
- unless $old->getfield('refnum') eq $new->getfield('refnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid referral. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a part_referral record!" unless $self->table eq "part_referral";
-
- my($error)=
- $self->ut_numbern('refnum')
- or $self->ut_text('referral')
- ;
- return $error if $error;
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The delete method is unimplemented.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-Class dealing with referrals
-
-ivan@sisd.com 98-feb-23
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::part_svc;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields fields);
-
-=head1 NAME
-
-FS::part_svc - Object methods for part_svc objects
-
-=head1 SYNOPSIS
-
- use FS::part_svc;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_svc represents a service definition. FS::part_svc inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcpart - primary key (assigned automatically for new service definitions)
-
-=item svc - text name of this service definition
-
-=item svcdb - table used for this service. See L<FS::svc_acct>,
-L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others.
-
-=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
-
-=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new service definition. To add the service definition to the
-database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_svc',$hashref);
-}
-
-=item insert
-
-Adds this service definition to the database. If there is an error, returns
-the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete service definitions.";
-# maybe check & make sure the svcpart isn't in cust_svc or (in any packages)?
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a part_svc record!" unless $old->table eq "part_svc";
- return "Can't change svcpart!"
- unless $old->getfield('svcpart') eq $new->getfield('svcpart');
- return "Can't change svcdb!"
- unless $old->getfield('svcdb') eq $new->getfield('svcdb');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service definition. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a part_svc record!" unless $self->table eq "part_svc";
- my($recref) = $self->hashref;
-
- my($error);
- return $error if $error=
- $self->ut_numbern('svcpart')
- || $self->ut_text('svc')
- || $self->ut_alpha('svcdb')
- ;
-
- my(@fields) = eval { fields($recref->{svcdb}) }; #might die
- return "Unknown svcdb!" unless @fields;
-
- my($svcdb);
- foreach $svcdb ( qw(
- svc_acct svc_acct_sm svc_charge svc_domain svc_wo
- ) ) {
- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc');
- my($row);
- foreach $row (@rows) {
- unless ( $svcdb eq $recref->{svcdb} ) {
- $recref->{$svcdb.'__'.$row}='';
- $recref->{$svcdb.'__'.$row.'_flag'}='';
- next;
- }
- $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
- or return "Illegal flag for $svcdb $row";
- $recref->{$svcdb.'__'.$row.'_flag'} = $1;
-
-# $recref->{$svcdb.'__'.$row} =~ /^(.*)$/ #not restrictive enough?
-# or return "Illegal value for $svcdb $row";
-# $recref->{$svcdb.'__'.$row} = $1;
- my($error);
- return $error if $error=$self->ut_anything($svcdb.'__'.$row);
-
- }
- }
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-Delete is unimplemented.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
-L<FS::svc_acct>, L<FS::svc_acct_sm>, L<FS::svc_domain>, schema.html from the
-base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 97-nov-14
-
-data checking/untainting calls into FS::Record added
-ivan@sisd.com 97-dec-6
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::pkg_svc;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-=head1 NAME
-
-FS::pkg_svc - Object methods for pkg_svc records
-
-=head1 SYNOPSIS
-
- use FS::pkg_svc;
-
- $record = create FS::pkg_svc \%hash;
- $record = create FS::pkg_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pkg_svc record links a billing item definition (see L<FS::part_pkg>) to
-a service definition (see L<FS::part_svc>). FS::pkg_svc inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
-
-=item svcpart - Service definition (see L<FS::part_svc>)
-
-=item quantity - Quantity of this service definition that this billing item
-definition includes
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('pkg_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('pkg_svc',$hashref);
-
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a pkg_svc record!" unless $old->table eq "pkg_svc";
- return "Can't change pkgpart!"
- if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change svcpart!"
- if $old->getfield('svcpart') ne $new->getfield('svcpart');
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a pkg_svc record!" unless $self->table eq "pkg_svc";
- my($recref) = $self->hashref;
-
- my($error);
- return $error if $error =
- $self->ut_number('pkgpart')
- || $self->ut_number('svcpart')
- || $self->ut_number('quantity')
- ;
-
- return "Unknown pkgpart!"
- unless qsearchs('part_pkg',{'pkgpart'=> $self->getfield('pkgpart')});
-
- return "Unknown svcpart!"
- unless qsearchs('part_svc',{'svcpart'=> $self->getfield('svcpart')});
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_pkg>, L<FS::part_svc>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1
-
-added hfields
-ivan@sisd.com 97-nov-13
-
-pod ivan@sisd.com 98-sep-22
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_acct;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $dir_prefix @shells
- $shellmachine @saltset @pw_set);
-use Exporter;
-use FS::Conf;
-use FS::Record qw(fields qsearchs);
-use FS::SSH qw(ssh);
-use FS::cust_svc;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-$dir_prefix = $conf->config('home');
-@shells = $conf->config('shells');
-$shellmachine = $conf->config('shellmachine');
-
-@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
-
-#not needed in 5.004 #srand($$|time);
-
-=head1 NAME
-
-FS::svc_acct - Object methods for svc_acct records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct;
-
- $record = create FS::svc_acct \%hash;
- $record = create FS::svc_acct { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an account. FS::svc_acct inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatcially for new accounts)
-
-=item username
-
-=item _password - generated if blank
-
-=item popnum - Point of presence (see L<FS::svc_acct_pop>)
-
-=item uid
-
-=item gid
-
-=item finger - GECOS
-
-=item dir - set automatically if blank (and uid is not)
-
-=item shell
-
-=item quota - (unimplementd)
-
-=item slipip - IP address
-
-=item radius_I<Radius_Attribute> - I<Radius-Attribute>
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new account. To add the account to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct',$hashref);
-
-}
-
-=item insert
-
-Adds this account to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-If the configuration value (see L<FS::Conf>) shellmachine exists, and the
-username, uid, and dir fields are defined, the command
-
- useradd -d $dir -m -s $shell -u $uid $username
-
-is executed on shellmachine via ssh. This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
-
-=cut
-
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- return "Username ". $self->username. " in use"
- if qsearchs('svc_acct',{'username'=> $self->username } );
-
- my($part_svc) = qsearchs('part_svc',{ 'svcpart' => $self->svcpart });
- return "Unkonwn svcpart" unless $part_svc;
- return "uid in use"
- if $part_svc->svc_acct__uid_flag ne 'F'
- && qsearchs('svc_acct',{'uid'=> $self->uid } )
- && $self->username !~ /^(hyla)?fax$/
- ;
-
- my($svcnum)=$self->svcnum;
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->pkgnum,
- 'svcpart' => $self->svcpart,
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->svcnum($cust_svc->svcnum);
- }
-
- $error = $self->add;
- if ($error) {
- #$cust_svc->del if $cust_svc;
- $cust_svc->delete if $cust_svc;
- return $error;
- }
-
- my($username,$uid,$dir,$shell) = (
- $self->username,
- $self->uid,
- $self->dir,
- $self->shell,
- );
- if ( $username
- && $uid
- && $dir
- && $shellmachine
- && ! $nossh_hack ) {
- #one way
- ssh("root\@$shellmachine",
- "useradd -d $dir -m -s $shell -u $uid $username"
- );
- #another way
- #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ".
- # "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ".
- # "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ".
- # "/bin/chown -R $uid $dir") unless $nossh_hack;
- }
-
- ''; #no error
-}
-
-=item 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.
-
-If the configuration value (see L<FS::Conf>) shellmachine exists, the command:
-
- userdel $username
-
-is executed on shellmachine via ssh. This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
-
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- my($username) = $self->getfield('username');
- if ( $username && $shellmachine && ! $nossh_hack ) {
- ssh("root\@$shellmachine","userdel $username");
- }
-
- '';
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If the configuration value (see L<FS::Conf>) shellmachine exists, and the
-dir field has changed, the command:
-
- [ -d $old_dir ] && (
- chmod u+t $old_dir;
- umask 022;
- mkdir $new_dir;
- cd $old_dir;
- find . -depth -print | cpio -pdm $new_dir;
- chmod u-t $new_dir;
- chown -R $uid.$gid $new_dir;
- rm -rf $old_dir
- )
-
-is executed on shellmachine via ssh. This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct record!" unless $old->table eq "svc_acct";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- return "Username in use"
- if $old->getfield('username') ne $new->getfield('username') &&
- qsearchs('svc_acct',{'username'=> $new->getfield('username') } );
-
- return "Can't change uid!"
- if $old->getfield('uid') ne $new->getfield('uid');
-
- #change homdir when we change username
- if ( $old->getfield('username') ne $new->getfield('username') ) {
- $new->setfield('dir','');
- }
-
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- my($old_dir,$new_dir)=( $old->getfield('dir'),$new->getfield('dir') );
- my($uid,$gid)=( $new->getfield('uid'), $new->getfield('gid') );
- if ( $old_dir
- && $new_dir
- && $old_dir ne $new_dir
- && ! $nossh_hack
- ) {
- ssh("root\@$shellmachine","[ -d $old_dir ] && ".
- "( chmod u+t $old_dir; ". #turn off qmail delivery
- "umask 022; mkdir $new_dir; cd $old_dir; ".
- "find . -depth -print | cpio -pdm $new_dir; ".
- "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ".
- "rm -rf $old_dir".
- ")"
- );
- }
-
- ''; #no error
-}
-
-=item suspend
-
-Suspends this account by prefixing *SUSPENDED* to the password. If there is an
-error, returns the error, otherwise returns false.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- my($old) = @_;
- my(%hash) = $old->hash;
- unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
- $hash{_password} = '*SUSPENDED* '.$hash{_password};
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
- } else {
- ''; #no error (already suspended)
- }
-
-}
-
-=item unsuspend
-
-Unsuspends this account by removing *SUSPENDED* from the password. If there is
-an error, returns the error, otherwise returns false.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- my($old) = @_;
- my(%hash) = $old->hash;
- if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
- $hash{_password} = $1;
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
- } else {
- ''; #no error (already unsuspended)
- }
-}
-
-=item cancel
-
-Just returns false (no error) for now.
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-# Usage: $error = $record -> cancel;
-sub cancel {
- ''; #stub (no error) - taken care of in delete
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_acct record!" unless $self->table eq "svc_acct";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
- my($ulen)=$self->dbdef_table->column('username')->length;
- $recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/
- or return "Illegal username";
- $recref->{username} = $1;
- $recref->{username} =~ /[a-z]/ or return "Illegal username";
-
- $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum";
- $recref->{popnum} = $1;
- return "Unkonwn popnum" unless
- ! $recref->{popnum} ||
- qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
-
- unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
-
- $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
- $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
-
- $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
- $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
- #not all systems use gid=uid
- #you can set a fixed gid in part_svc
-
- return "Only root can have uid 0"
- if $recref->{uid} == 0 && $recref->{username} ne 'root';
-
- my($error);
- return $error if $error=$self->ut_textn('finger');
-
- $recref->{dir} =~ /^([\/\w\-]*)$/
- or return "Illegal directory";
- $recref->{dir} = $1 ||
- $dir_prefix . '/' . $recref->{username}
- #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
- ;
-
- unless ( $recref->{username} eq 'sync' ) {
- my($shell);
- if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) {
- $recref->{shell} = $shell;
- } else {
- return "Illegal shell ". $self->shell;
- }
- } else {
- $recref->{shell} = '/bin/sync';
- }
-
- $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
- $recref->{quota} = $1;
-
- } else {
- $recref->{gid} ne '' ?
- return "Can't have gid without uid" : ( $recref->{gid}='' );
- $recref->{finger} ne '' ?
- return "Can't have finger-name without uid" : ( $recref->{finger}='' );
- $recref->{dir} ne '' ?
- return "Can't have directory without uid" : ( $recref->{dir}='' );
- $recref->{shell} ne '' ?
- return "Can't have shell without uid" : ( $recref->{shell}='' );
- $recref->{quota} ne '' ?
- return "Can't have quota without uid" : ( $recref->{quota}='' );
- }
-
- unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
- unless ( $recref->{slipip} eq '0e0' ) {
- $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
- or return "Illegal slipip". $self->slipip;
- $recref->{slipip} = $1;
- } else {
- $recref->{slipip} = '0e0';
- }
-
- }
-
- #arbitrary RADIUS stuff; allow ut_textn for now
- foreach ( grep /^radius_/, fields('svc_acct') ) {
- $self->ut_textn($_);
- }
-
- #generate a password if it is blank
- $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
- unless ( $recref->{_password} );
-
- #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
- if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,8})$/ ) {
- $recref->{_password} = $1.$3;
- #uncomment this to encrypt password immediately upon entry, or run
- #bin/crypt_pw in cron to give new users a window during which their
- #password is available to techs, for faxing, etc. (also be aware of
- #radius issues!)
- #$recref->{password} = $1.
- # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
- #;
- } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/]{13,24})$/ ) {
- $recref->{_password} = $1.$3;
- } elsif ( $recref->{_password} eq '*' ) {
- $recref->{_password} = '*';
- } else {
- return "Illegal password";
- }
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The remote commands should be configurable.
-
-The create method should set defaults from part_svc (like the check method
-sets fixed values).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-16 - 21
-
-rewrite (among other things, now know about part_svc) ivan@sisd.com 98-mar-8
-
-Changed 'password' to '_password' because Pg6.3 reserves the password word
- bmccane@maxbaud.net 98-apr-3
-
-username length and shell no longer hardcoded ivan@sisd.com 98-jun-28
-
-eww but needed: ignore uid duplicates for 'fax' and 'hylafax'
-ivan@sisd.com 98-jun-29
-
-$nossh_hack ivan@sisd.com 98-jul-13
-
-protections against UID/GID of 0 for incorrectly-setup RDBMSs (also
-in bin/svc_acct.export) ivan@sisd.com 98-jul-13
-
-arbitrary radius attributes ivan@sisd.com 98-aug-13
-
-/var/spool/freeside/conf/shellmachine ivan@sisd.com 98-aug-13
-
-pod and FS::conf ivan@sisd.com 98-sep-22
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_acct_pop;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::svc_acct_pop - Object methods for svc_acct_pop records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct_pop;
-
- $record = create FS::svc_acct_pop \%hash;
- $record = create FS::svc_acct_pop { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an point of presence. FS::svc_acct_pop
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item popnum - primary key (assigned automatically for new accounts)
-
-=item city
-
-=item state
-
-=item ac - area code
-
-=item exch - exchange
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new point of presence (if only it were that easy!). To add the
-point of presence to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_pop')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_pop',$hashref);
-}
-
-=item insert
-
-Adds this point of presence to the databaes. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't (yet) delete POPs!";
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an svc_acct_pop record!"
- unless $old->table eq "svc_acct_pop";
- return "Can't change popnum!"
- unless $old->getfield('popnum') eq $new->getfield('popnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid point of presence. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_acct_pop record!" unless $self->table eq "svc_acct_pop";
-
- my($error)=
- $self->ut_numbern('popnum')
- or $self->ut_text('city')
- or $self->ut_text('state')
- or $self->ut_number('ac')
- or $self->ut_number('exch')
- ;
- return $error if $error;
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-It should be renamed to part_pop.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<svc_acct>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-Class dealing with pops
-
-ivan@sisd.com 98-mar-8
-
-pod ivan@sisd.com 98-sep-23
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_acct_sm;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $shellmachine @qmailmachines);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
-use FS::SSH qw(ssh);
-use FS::Conf;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-
-$shellmachine = $conf->exists('qmailmachines')
- ? $conf->config('shellmachine')
- : '';
-
-=head1 NAME
-
-FS::svc_acct_sm - Object methods for svc_acct_sm records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct_sm;
-
- $record = create FS::svc_acct_sm \%hash;
- $record = create FS::svc_acct_sm { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents a virtual mail alias. FS::svc_acct inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatcially for new accounts)
-
-=item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>)
-
-=item domuid - uid of the target account (see L<FS::svc_acct>)
-
-=item domuser - virtual username
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new virtual mail alias. To add the virtual mail alias to the
-database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_sm')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_sm',$hashref);
-
-}
-
-=item insert
-
-Adds this virtual mail alias to the database. If there is an error, returns
-the error, otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines
-exist, and domuser is `*' (meaning a catch-all mailbox), the command:
-
- [ -e $dir/.qmail-$qdomain-default ] || {
- touch $dir/.qmail-$qdomain-default;
- chown $uid:$gid $dir/.qmail-$qdomain-default;
- }
-
-is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
-This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.
-
-=cut
-
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- return "Domain username (domuser) in use for this domain (domsvc)"
- if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser,
- 'domsvc' => $self->domsvc,
- } );
-
- return "First domain username (domuser) for domain (domsvc) must be " .
- qq='*' (catch-all)!=
- if $self->domuser ne '*' &&
- ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } );
-
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
-
- my $svc_domain = qsearchs('svc_domain',{'svcnum'=> $self->domsvc } );
- my $svc_acct = qsearchs('svc_acct',{'uid'=> $self->domuid } );
- my($uid,$gid,$dir,$domain)=(
- $svc_acct->getfield('uid'),
- $svc_acct->getfield('gid'),
- $svc_acct->getfield('dir'),
- $svc_domain->getfield('domain')
- );
- my($qdomain)=$domain;
- $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
- ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
- if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
-
- ''; #no error
-
-}
-
-=item delete
-
-Deletes this virtual mail alias 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.
-
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct_sm record!" unless $old->table eq "svc_acct_sm";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- return "Domain username (domuser) in use for this domain (domsvc)"
- if ( $old->domuser ne $new->domuser
- || $old->domsvc ne $new->domsvc
- ) && qsearchs('svc_acct_sm',{
- 'domuser'=> $new->domuser,
- 'domsvc' => $new->domsvc,
- } )
- ;
-
- $error=$new->check;
- return $error if $error;
-
- $error = $new->rep($old);
- return $error if $error;
-
- ''; #no error
-}
-
-=item suspend
-
-Just returns false (no error) for now.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
-=item unsuspend
-
-Just returns false (no error) for now.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
-=item cancel
-
-Just returns false (no error) for now.
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
-=item check
-
-Checks all fields to make sure this is a valid virtual mail alias. If there is
-an error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_acct_sm record!" unless $self->table eq "svc_acct_sm";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct_sm') ) {
- if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
- }
- }
-
- $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
- or return "Illegal domain username (domuser)";
- $recref->{domuser} = $1;
-
- $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
- $recref->{domsvc} = $1;
- my($svc_domain);
- return "Unknown domsvc" unless
- $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
-
- $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
- $recref->{domuid} = $1;
- my($svc_acct);
- return "Unknown uid" unless
- $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The remote commands should be configurable.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::svc_acct>, L<FS::svc_domain>, L<FS::SSH>, L<ssh>, L<dot-qmail>,
-schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-16 - 21
-
-rewrite ivan@sisd.com 98-mar-10
-
-s/qsearchs/qsearch/ to eliminate warning ivan@sisd.com 98-apr-19
-
-uses conf/shellmachine and has an nossh_hack ivan@sisd.com 98-jul-14
-
-s/\./:/g in .qmail-domain:com ivan@sisd.com 98-aug-13
-
-pod, FS::Conf, moved .qmail file from check to insert 98-sep-23
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_domain;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine);
-use Exporter;
-use Carp;
-use Mail::Internet;
-use Mail::Header;
-use Date::Format;
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
-use FS::Conf;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-
-$mydomain = $conf->config('domain');
-$smtpmachine = $conf->config('smtpmachine');
-
-my($internic)="/var/spool/freeside/conf/registries/internic";
-my($conf_tech)="$internic/tech_contact";
-my($conf_from)="$internic/from";
-my($conf_to)="$internic/to";
-my($nameservers)="$internic/nameservers";
-my($template)="$internic/template";
-
-open(TECH_CONTACT,$conf_tech) or die "Can't open $conf_tech: $!";
-my($tech_contact)=map {
- /^(.*)$/ or die "Illegal line in $conf_tech!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TECH_CONTACT>;
-close TECH_CONTACT;
-
-open(FROM,$conf_from) or die "Can't open $conf_from: $!";
-my($from)=map {
- /^(.*)$/ or die "Illegal line in $conf_from!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <FROM>;
-close FROM;
-
-open(TO,$conf_to) or die "Can't open $conf_to: $!";
-my($to)=map {
- /^(.*)$/ or die "Illegal line in $conf_to!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TO>;
-close TO;
-
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameservers)=map {
- /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameserver_ips)=map {
- /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-
-open(TEMPLATE,$template) or die "Can't open $template: $!";
-my(@template)=map {
- /^(.*)$/ or die "Illegal line in $to!"; #yes, we trust the file
- $1. "\n";
-} <TEMPLATE>;
-close TEMPLATE;
-
-=head1 NAME
-
-FS::svc_domain - Object methods for svc_domain records
-
-=head1 SYNOPSIS
-
- use FS::svc_domain;
-
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_domain object represents a domain. FS::svc_domain inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatically for new accounts)
-
-=item domain
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new domain. To add the domain to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_domain')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_domain',$hashref);
-
-}
-
-=item insert
-
-Adds this domain to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-The additional field I<action> should be set to I<N> for new domains or I<M>
-for transfers.
-
-A registration or transfer email will be submitted unless
-$FS::svc_domain::whois_hack is true.
-
-=cut
-
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- return "Domain in use (here)"
- if qsearchs('svc_domain',{'domain'=> $self->domain } );
-
- my($whois)=(($self->_whois)[0]);
- return "Domain in use (see whois)"
- if ( $self->action eq "N" && $whois !~ /^No match for/ );
- return "Domain not found (see whois)"
- if ( $self->action eq "M" && $whois =~ /^No match for/ );
-
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
-
- $self->submit_internic unless $whois_hack;
-
- ''; #no error
-}
-
-=item delete
-
-Deletes this domain 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.
-
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_domain record!" unless $old->table eq "svc_domain";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- return "Can't change domain - reorder."
- if $old->getfield('domain') ne $new->getfield('domain');
-
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- '';
-
-}
-
-=item suspend
-
-Just returns false (no error) for now.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
-=item unsuspend
-
-Just returns false (no error) for now.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
-=item cancel
-
-Just returns false (no error) for now.
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
-=item check
-
-Checks all fields to make sure this is a valid domain. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_domain record!" unless $self->table eq "svc_domain";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc (and pkgnum)
- my($svcpart,$pkgnum);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- $pkgnum=$cust_svc->pkgnum;
- } else {
- $svcpart=$self->svcpart;
- $pkgnum=$self->pkgnum;
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
- }
- }
-
- unless ( $whois_hack ) {
- unless ( $self->email ) { #find out an email address
- my(@svc_acct);
- foreach ( qsearch('cust_svc',{'pkgnum'=>$pkgnum}) ) {
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$_->svcnum});
- push @svc_acct, $svc_acct if $svc_acct;
- }
-
- if ( scalar(@svc_acct) == 0 ) {
- return "Must order an account first";
- } elsif ( scalar(@svc_acct) > 1 ) {
- return "More than one account in package ". $pkgnum. ": specify admin contact email";
- } else {
- $self->email($svc_acct[0]->username. '@'. $mydomain);
- }
- }
- }
-
- #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
- if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) {
- $recref->{domain} = "$1.$2";
- # hmmmmmmmm.
- } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) {
- $recref->{domain} = $1;
- } else {
- return "Illegal domain ". $recref->{domain}.
- " (or unknown registry - try \$whois_hack)";
- }
-
- $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
- $recref->{action} = $1;
-
- $self->ut_textn('purpose');
-
-}
-
-=item _whois
-
-Executes the command:
-
- whois do $domain
-
-and returns the output.
-
-(Always returns I<No match for domian "$domain".> if
-$FS::svc_domain::whois_hack is set true.)
-
-=cut
-
-sub _whois {
- my($self)=@_;
- my($domain)=$self->domain;
- return ( "No match for domain \"$domain\"." ) if $whois_hack;
- open(WHOIS,"whois do $domain |");
- return <WHOIS>;
-}
-
-=item submit_internic
-
-Submits a registration email for this domain.
-
-=cut
-
-sub submit_internic {
- my($self)=@_;
-
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$self->pkgnum});
- return unless $cust_pkg;
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
- return unless $cust_main;
-
- my(%subs)=(
- 'action' => $self->action,
- 'purpose' => $self->purpose,
- 'domain' => $self->domain,
- 'company' => $cust_main->company
- || $cust_main->getfield('first'). ' '.
- $cust_main->getfield('last')
- ,
- 'city' => $cust_main->city,
- 'state' => $cust_main->state,
- 'zip' => $cust_main->zip,
- 'country' => $cust_main->country,
- 'last' => $cust_main->getfield('last'),
- 'first' => $cust_main->getfield('first'),
- 'daytime' => $cust_main->daytime,
- 'fax' => $cust_main->fax,
- 'email' => $self->email,
- 'tech_contact' => $tech_contact,
- 'primary' => shift @nameservers,
- 'primary_ip' => shift @nameserver_ips,
- );
-
- #yuck
- my(@xtemplate)=@template;
- my(@body);
- my($line);
- OLOOP: while ( defined($line = shift @xtemplate) ) {
-
- if ( $line =~ /^###LOOP###$/ ) {
- my(@buffer);
- LOADBUF: while ( defined($line = shift @xtemplate) ) {
- last LOADBUF if ( $line =~ /^###ENDLOOP###$/ );
- push @buffer, $line;
- }
- my(%lubs)=(
- 'address' => $cust_main->address2
- ? [ $cust_main->address1, $cust_main->address2 ]
- : [ $cust_main->address1 ]
- ,
- 'secondary' => [ @nameservers ],
- 'secondary_ip' => [ @nameserver_ips ],
- );
- LOOP: while (1) {
- my(@xbuffer)=@buffer;
- SUBLOOP: while ( defined($line = shift @xbuffer) ) {
- if ( $line =~ /###(\w+)###/ ) {
- #last LOOP unless my($lub)=shift@{$lubs{$1}};
- next OLOOP unless my $lub = shift @{$lubs{$1}};
- $line =~ s/###(\w+)###/$lub/e;
- redo SUBLOOP;
- } else {
- push @body, $line;
- }
- } #SUBLOOP
- } #LOOP
-
- }
-
- if ( $line =~ /###(\w+)###/ ) {
- #$line =~ s/###(\w+)###/$subs{$1}/eg;
- $line =~ s/###(\w+)###/$subs{$1}/e;
- redo OLOOP;
- } else {
- push @body, $line;
- }
-
- } #OLOOP
-
- my($subject);
- if ( $self->action eq "M" ) {
- $subject = "MODIFY DOMAIN ". $self->domain;
- } elsif ($self->action eq "N" ) {
- $subject = "NEW DOMAIN ". $self->domain;
- } else {
- croak "submit_internic called with action ". $self->action;
- }
-
- $ENV{SMTPHOSTS}=$smtpmachine;
- $ENV{MAILADDRESS}=$from;
- my($header)=Mail::Header->new( [
- "From: $from",
- "To: $to",
- "Sender: $from",
- "Reply-To: $from",
- "Date: ". time2str("%a, %d %b %Y %X %z",time),
- "Subject: $subject",
- ] );
-
- my($msg)=Mail::Internet->new(
- 'Header' => $header,
- 'Body' => \@body,
- );
-
- $msg->smtpsend or die "Can't send registration email"; #die? warn?
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-All BIND/DNS fields should be included (and exported).
-
-All registries should be supported.
-
-Not all configuration access is through FS::Conf!
-
-Should change action to a real field.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation,
-config.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-21
-
-rewrite ivan@sisd.com 98-mar-10
-
-add internic bits ivan@sisd.com 98-mar-14
-
-Changed 'day' to 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
-/var/spool/freeside/conf/registries/internic/, Mail::Internet, etc.
-ivan@sisd.com 98-jul-17-19
-
-pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
-
-=cut
-
-1;
-
-
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-21
-
-package FS::svc_table;
-
-use strict;
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@FS::svc_table::ISA = qw(FS::Record Exporter);
-
-# Usage: $record = create FS::svc_table ( \%hash );
-# $record = create FS::svc_table ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('svc_table')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('svc_table',$hashref);
-
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- $error = $self->add;
- return $error if $error;
-
- ''; #no error
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
- my($error);
-
- $error = $self->del;
- return $error if $error;
-
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_table record!" unless $old->table eq "svc_table";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- $error=$new->check;
- return $error if $error;
-
- $error = $new->rep($old);
- return $error if $error;
-
- ''; #no error
-}
-
-# Usage: $error = $record -> suspend;
-sub suspend {
- ''; #no error (stub)
-}
-
-# Usage: $error = $record -> unsuspend;
-sub unsuspend {
- ''; #no error (stub)
-}
-
-# Usage: $error = $record -> cancel;
-sub cancel {
- ''; #no error (stub)
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a svc_table record!" unless $self->table eq "svc_table";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d+)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
- return "Unknown svcnum" unless
- qsearchs('cust_svc',{'svcnum'=> $recref->{svcnum} } );
-
- #DATA CHECKS GO HERE!
-
- ''; #no error
-}
-
-1;
-
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-1
-#
-# added hfields
-# ivan@sisd.com 97-nov-13
-
-package FS::table_name;
-
-use strict;
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearch qsearchs);
-
-@FS::table_name::ISA = qw(FS::Record Exporter);
-@FS::table_name::EXPORT_OK = qw(hfields);
-
-# Usage: $record = create FS::table_name ( \%hash );
-# $record = create FS::table_name ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('table_name')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('table_name',$hashref);
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
- return "Can't change keyfield!"
- unless $old->getfield('keyfield') eq $new->getfield('keyfield');
- $new->check or
- $new->rep($old);
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
- my($recref) = $self->hashref;
-
- ''; #no error
-}
-
-1;
-
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-1
-#
-# added hfields
-# ivan@sisd.com 97-nov-13
-
-package FS::table_name;
-
-use strict;
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(hfields qsearch qsearchs);
-
-@FS::table_name::ISA = qw(FS::Record Exporter);
-@FS::table_name::EXPORT_OK = qw(hfields);
-
-# Usage: $record = create FS::table_name ( \%hash );
-# $record = create FS::table_name ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('table_name')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('table_name',$hashref);
-
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
-
- $new->check or
- $new->rep($old);
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
- my($recref) = $self->hashref;
-
- ''; #no error
-}
-
-1;
-
+++ /dev/null
-package FS::type_pkgs;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::type_pkgs - Object methods for type_pkgs records
-
-=head1 SYNOPSIS
-
- use FS::type_pkgs;
-
- $record = create FS::type_pkgs \%hash;
- $record = create FS::type_pkgs { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::type_pkgs record links an agent type (see L<FS::agent_type>) to a
-billing item definition (see L<FS::part_pkg>). FS::type_pkgs inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typenum - Agent type, see L<FS::agent_type>
-
-=item pkgpart - Billing item definition, see L<FS::part_pkg>
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('type_pkgs')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('type_pkgs',$hashref);
-
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a type_pkgs record!" unless $old->table eq "type_pkgs";
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a type_pkgs record!" unless $self->table eq "type_pkgs";
- my($recref) = $self->hashref;
-
- $recref->{typenum} =~ /^(\d+)$/ or return "Illegal typenum";
- $recref->{typenum} = $1;
- return "Unknown typenum"
- unless qsearchs('agent_type',{'typenum'=>$recref->{typenum}});
-
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart} = $1;
- return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
-
- ''; #no error
-}
-
-=back
-
-=head1 HISTORY
-
-Defines the relation between agent types and pkgparts
-(Which pkgparts can the different [types of] agents sell?)
-
-ivan@sisd.com 97-nov-13
-
-change to ut_ FS::Record, fixed bugs
-ivan@sisd.com 97-dec-10
-
-=cut
-
-1;
-
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cgi-test,v 1.3 2001-08-21 02:32:54 ivan Exp $
+#
+# This is the beginning of a test suite for the web interface.
+# It's also excellent for populating your database with some meaningful test
+# data. (a derivative is used by the web demo)
+# It only works on an empty database (probably need empty counters too, and
+# no arbirary RADIUS attributes).
+# Usage: cgi-test http://base.freeside.url/with/path/ username password
+# (Yes, if you were properly paranoid and are using SSL, you'll need to get
+# libwww-perl working with SSL to use this.)
+
+use strict;
+#use diagnostics;
+use subs qw( big_ugly_data_structure );
+use CGI;
+use LWP::UserAgent;
+
+my ( $base_url, $username, $password ) = ( shift, shift, shift );
+#trust 'em
+$base_url =~ /^(.*)$/; $base_url = $1;
+$username =~ /^(.*)$/; $username = $1;
+$password =~ /^(.*)$/; $password = $1;
+
+my @data = &big_ugly_data_structure;
+
+my $ua = new LWP::UserAgent;
+{
+ local $^W = 0;
+ eval '
+ sub LWP::UserAgent::get_basic_credentials {
+ #my $self = shift;
+ ( $username, $password );
+ }
+ ';
+}
+
+my $data;
+while ( $data = shift @data ) {
+ my $cgi = new CGI ( $data->{'params'} );
+ my $full_url = $base_url. $data->{'url'}. '?'. $cgi->query_string;
+ #my $request = new HTTP::Request( 'POST', $full_url );
+ my $request = new HTTP::Request( 'GET', $full_url );
+ my $response = $ua->request( $request );
+ if ( $response->is_redirect ) {
+ die "Unexpected redirect!\n".
+ "URL: $full_url\n".
+ "To: ". $response->base. "\n"
+ ;
+ } elsif ( $response->is_success ) {
+ my $location = $response->base;
+ my $expected_location = $data->{'location'};
+ #if ( $location =~ /^$base_url$expected_location$/ ) {
+ if ( $location eq $base_url. $expected_location ) {
+ #warn "cool, got expected response $location from $full_url\n";
+ } else {
+ die "Strange, regular response, but unexpected base!\n".
+ "URL: $full_url\n".
+ "Base : ". $response->base. "\n".
+ "Expected: $base_url$expected_location\n".
+ "Output: ". $response->content. "\n"
+ ;
+ }
+ } elsif ( $response->is_error ) {
+ die "Strange, I got an error\n".
+ "URL: $full_url\n".
+ "Error: ". $response->error_as_HTML. "\n".
+ "Output: ". $response->content. "\n"
+ ;
+ } elsif ( $response->is_info ) {
+ die "Strange, I got an info reponse\n".
+ "URL: $full_url\n".
+ "Output: ". $response->content. "\n"
+ ;
+ } else {
+ die "Really strange, got an unrecognized response from LWP::UserAgent!\n";
+ }
+}
+
+#---
+
+sub big_ugly_data_structure {
+
+ (
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'Shell',
+ 'svcdb' => 'svc_acct',
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => 'F',
+ 'svc_acct__quota' => '10',
+ 'svc_acct__slipip_flag' => 'F',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => 'D',
+ 'svc_acct__shell' => '/bin/sh',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'SLIP/PPP',
+ 'svcdb' => 'svc_acct',
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => 'F',
+ 'svc_acct__quota' => '10',
+ 'svc_acct__slipip_flag' => 'D',
+ 'svc_acct__slipip' => '0.0.0.0',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => 'D',
+ 'svc_acct__shell' => '/bin/sh',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'POP Mailbox',
+ 'svcdb' => 'svc_acct',,
+ 'svc_acct__popnum_flag' => 'F',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => 'F',
+ 'svc_acct__quota' => '10',
+ 'svc_acct__slipip_flag' => 'F',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => 'F',
+ 'svc_acct__shell' => '/bin/passwd',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'Domain',
+ 'svcdb' => 'svc_domain',,
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => '',
+ 'svc_acct__quota' => '',
+ 'svc_acct__slipip_flag' => '',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => '',
+ 'svc_acct__shell' => '',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+ { 'url' => 'edit/process/part_svc.cgi',
+ 'params' => {
+ 'svcpart' => '',
+ 'svc' => 'Domain email alias',
+ 'svcdb' => 'svc_acct_sm',,
+ 'svc_acct__popnum_flag' => '',
+ 'svc_acct__popnum' => '',
+ 'svc_acct__dir_flag' => '',
+ 'svc_acct__dir' => '',
+ 'svc_acct__username_flag' => '',
+ 'svc_acct__username' => '',
+ 'svc_acct__uid_flag' => '',
+ 'svc_acct__uid' => '',
+ 'svc_acct__quota_flag' => '',
+ 'svc_acct__quota' => '',
+ 'svc_acct__slipip_flag' => '',
+ 'svc_acct__slipip' => '',
+ 'svc_acct___password_flag' => '',
+ 'svc_acct___password' => '',
+ 'svc_acct__gid_flag' => '',
+ 'svc_acct__gid' => '',
+ 'svc_acct__shell_flag' => '',
+ 'svc_acct__shell' => '',
+ 'svc_acct__finger_flag' => '',
+ 'svc_acct__finger' => '',
+ 'svc_domain__domain_flag' => '',
+ 'svc_domain__domain' => '',
+ 'svc_acct_sm__domuser_flag' => '',
+ 'svc_acct_sm__domuser' => '',
+ 'svc_acct_sm__domuid_flag' => '',
+ 'svc_acct_sm__domuid' => '',
+ 'svc_acct_sm__domsvc_flag' => '',
+ 'svc_acct_sm__domsvc' => '',
+ },
+ 'location' => 'browse/part_svc.cgi',
+ },
+
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Personal SLIP/PPP',
+ 'comment' => '$30/setup, $19.99/month',
+ 'setup' => '30',
+ 'recur' => '19.99',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Personal SLIP/PPP',
+ 'comment' => '$0/setup, $179.88/year',
+ 'setup' => '0',
+ 'recur' => '179.88',
+ 'freq' => '12',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Personal POP mailbox',
+ 'comment' => '$10/setup, $5/month',
+ 'setup' => '10',
+ 'recur' => '5',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '1',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Business SLIP/PPP',
+ 'comment' => '$30/setup, $29.99/month',
+ 'setup' => '30',
+ 'recur' => '29.99',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '1',
+ 'pkg_svc5' => '1',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Business SLIP/PPP',
+ 'comment' => '$0/setup, $299.88/year',
+ 'setup' => '0',
+ 'recur' => '299.88',
+ 'freq' => '12',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '1',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '1',
+ 'pkg_svc5' => '1',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Business POP mailbox',
+ 'comment' => '$10/setup, $5/month',
+ 'setup' => '10',
+ 'recur' => '5',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '1',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '1',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'UNIX shell',
+ 'comment' => '$20/setup, $9.99/month',
+ 'setup' => '20',
+ 'recur' => '9.99',
+ 'freq' => '1',
+ 'pkg_svc1' => '1',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Point-to-point T1',
+ 'comment' => '$1000/setup, $1000/month',
+ 'setup' => '1000',
+ 'recur' => '1000',
+ 'freq' => '1',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '5',
+ 'pkg_svc4' => '1',
+ 'pkg_svc5' => '5',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+ { 'url' => 'edit/process/part_pkg.cgi',
+ 'params' => {
+ 'pkgpart' => '',
+ 'pkg' => 'Cisco 2501 Router',
+ 'comment' => '$2500',
+ 'setup' => '2500',
+ 'recur' => '0',
+ 'freq' => '0',
+ 'pkg_svc1' => '0',
+ 'pkg_svc2' => '0',
+ 'pkg_svc3' => '0',
+ 'pkg_svc4' => '0',
+ 'pkg_svc5' => '0',
+ },
+ 'location' => 'browse/part_pkg.cgi',
+ },
+
+ { 'url' => 'edit/process/agent_type.cgi',
+ 'params' => {
+ 'typenum' => '',
+ 'atype' => 'Internal Sales',
+ 'pkgpart1' => 'ON',
+ 'pkgpart2' => 'ON',
+ 'pkgpart3' => 'ON',
+ 'pkgpart4' => 'ON',
+ 'pkgpart5' => 'ON',
+ 'pkgpart6' => 'ON',
+ 'pkgpart7' => 'ON',
+ 'pkgpart8' => 'ON',
+ 'pkgpart9' => 'ON',
+ },
+ 'location' => 'browse/agent_type.cgi',
+ },
+
+ { 'url' => 'edit/process/agent.cgi',
+ 'params' => {
+ 'agentnum' => '',
+ 'agent' => 'Internal Sales',
+ 'typenum' => '1',
+ 'freq' => '',
+ 'prog' => '',
+ },
+ 'location' => 'browse/agent.cgi',
+ },
+
+ { 'url' => 'edit/process/part_referral.cgi',
+ 'params' => {
+ 'refnum' => '',
+ 'referral' => 'Another customer',
+ },
+ 'location' => 'browse/part_referral.cgi',
+ },
+ { 'url' => 'edit/process/part_referral.cgi',
+ 'params' => {
+ 'refnum' => '',
+ 'referral' => 'Newspaper ad',
+ },
+ 'location' => 'browse/part_referral.cgi',
+ },
+
+ { 'url' => 'edit/process/svc_acct_pop.cgi',
+ 'params' => {
+ 'popnum' => '',
+ 'city' => 'Line Lexington',
+ 'state' => 'PA',
+ 'ac' => '215',
+ 'exch' => '996',
+ },
+ 'location' => 'browse/svc_acct_pop.cgi',
+ },
+ { 'url' => 'edit/process/svc_acct_pop.cgi',
+ 'params' => {
+ 'popnum' => '',
+ 'city' => 'Oakland',
+ 'state' => 'CA',
+ 'ac' => '510',
+ 'exch' => '208',
+ },
+ 'location' => 'browse/svc_acct_pop.cgi',
+ },
+
+ { 'url' => 'edit/process/cust_main.cgi',
+ 'params' => {
+ 'custnum' => '',
+ 'agentnum' => '1',
+ 'refnum' => '1',
+ 'last' => 'Hogan',
+ 'first' => 'Shawn D.',
+ 'ss' => '',
+ 'company' => 'Digital Point Solutions',
+ 'address1' => '3570 Tony Drive',
+ 'address2' => '',
+ 'city' => 'San Diego',
+ 'state' => 'CA / US',
+ 'zip' => '92122-2307',
+ 'daytime' => '',
+ 'night' => '',
+ 'fax' => '',
+ 'tax' => '',
+ 'invoicing_list_POST' => '',
+ 'invoicing_list' => '',
+ 'payby' => 'BILL',
+ 'CARD_payinfo' => '',
+ 'CARD_month' => '1',
+ 'CARD_year' => '1999',
+ 'CARD_payname' => '',
+ 'BILL_payinfo' => '',
+ 'BILL_month' => '12',
+ 'BILL_year' => '2037',
+ 'BILL_payname' => 'Accounts Payable',
+ 'COMP_payinfo' => '',
+ 'COMP_month' => '1',
+ 'COMP_year' => '1999',
+ 'pkgpart_svcpart' => '1_2',
+ 'username' => 'cyborg',
+ '_password' => '',
+ 'popnum' => '1',
+ 'otaker' => 'example',
+ },
+ 'location' => 'view/cust_main.cgi?1',
+ },
+ { 'url' => 'edit/process/cust_main.cgi',
+ 'params' => {
+ 'custnum' => '',
+ 'agentnum' => '1',
+ 'refnum' => '2',
+ 'last' => 'Ford',
+ 'first' => 'Bill',
+ 'ss' => '',
+ 'company' => 'Boardtown Corporation',
+ 'address1' => '116 East Main Street',
+ 'address2' => '',
+ 'city' => 'Starkville',
+ 'state' => 'MS / US',
+ 'zip' => '39759',
+ 'daytime' => '',
+ 'night' => '',
+ 'fax' => '',
+ 'tax' => '',
+ 'invoicing_list_POST' => '',
+ 'invoicing_list' => '',
+ 'payby' => 'BILL',
+ 'CARD_payinfo' => '',
+ 'CARD_month' => '1',
+ 'CARD_year' => '1999',
+ 'CARD_payname' => '',
+ 'BILL_payinfo' => '',
+ 'BILL_month' => '12',
+ 'BILL_year' => '2037',
+ 'BILL_payname' => 'Accounts Payable',
+ 'COMP_payinfo' => '',
+ 'COMP_month' => '1',
+ 'COMP_year' => '1999',
+ 'pkgpart_svcpart' => '3_3',
+ 'username' => 'billf',
+ '_password' => '',
+ 'popnum' => '',
+ 'otaker' => 'example',
+ },
+ 'location' => 'view/cust_main.cgi?2',
+ },
+
+
+ );
+}
+
projects / freeside.git / commitdiff
