--- /dev/null
+ The "Artistic License"
+
+ Preamble
+
+The intent of this document is to state the conditions under which a
+Package may be copied, such that the Copyright Holder maintains some
+semblance of artistic control over the development of the Package,
+while giving the users of the package the right to use and distribute
+the Package in a more-or-less customary fashion, plus the right to make
+reasonable modifications.
+
+It also grants you the rights to reuse parts of a Package in your own
+programs without transferring this License to those programs, provided
+that you meet some reasonable requirements.
+
+Definitions:
+
+ "Package" refers to the collection of files distributed by the
+ Copyright Holder, and derivatives of that collection of files
+ created through textual modification.
+
+ "Standard Version" refers to such a Package if it has not been
+ modified, or has been modified in accordance with the wishes
+ of the Copyright Holder as specified below.
+
+ "Copyright Holder" is whoever is named in the copyright or
+ copyrights for the package.
+
+ "You" is you, if you're thinking about copying or distributing
+ this Package.
+
+ "Reasonable copying fee" is whatever you can justify on the
+ basis of media cost, duplication charges, time of people involved,
+ and so on. (You will not be required to justify it to the
+ Copyright Holder, but only to the computing community at large
+ as a market that must bear the fee.)
+
+ "Freely Available" means that no fee is charged for the item
+ itself, though there may be fees involved in handling the item.
+ It also means that recipients of the item may redistribute it
+ under the same conditions they received it.
+
+1. You may make and give away verbatim copies of the source form of the
+Standard Version of this Package without restriction, provided that you
+duplicate all of the original copyright notices and associated disclaimers.
+
+2. You may apply bug fixes, portability fixes and other modifications
+derived from the Public Domain or from the Copyright Holder. A Package
+modified in such a way shall still be considered the Standard Version.
+
+3. You may otherwise modify your copy of this Package in any way, provided
+that you insert a prominent notice in each changed file stating how and
+when you changed that file, and provided that you do at least ONE of the
+following:
+
+ a) place your modifications in the Public Domain or otherwise make them
+ Freely Available, such as by posting said modifications to Usenet or
+ an equivalent medium, or placing the modifications on a major archive
+ site such as uunet.uu.net, or by allowing the Copyright Holder to include
+ your modifications in the Standard Version of the Package.
+
+ b) use the modified Package only within your corporation or organization.
+
+ c) rename any non-standard executables so the names do not conflict
+ with standard executables, which must also be provided, and provide
+ a separate manual page for each non-standard executable that clearly
+ documents how it differs from the Standard Version.
+
+ d) make other distribution arrangements with the Copyright Holder.
+
+4. You may distribute the programs of this Package in object code or
+executable form, provided that you do at least ONE of the following:
+
+ a) distribute a Standard Version of the executables and library files,
+ together with instructions (in the manual page or equivalent) on where
+ to get the Standard Version.
+
+ b) accompany the distribution with the machine-readable source of
+ the Package with your modifications.
+
+ c) give non-standard executables non-standard names, and clearly
+ document the differences in manual pages (or equivalent), together
+ with instructions on where to get the Standard Version.
+
+ d) make other distribution arrangements with the Copyright Holder.
+
+5. You may charge a reasonable copying fee for any distribution of this
+Package. You may charge any fee you choose for support of this
+Package. You may not charge a fee for this Package itself. However,
+you may distribute this Package in aggregate with other (possibly
+commercial) programs as part of a larger (possibly commercial) software
+distribution provided that you do not advertise this Package as a
+product of your own.
+
+6. The scripts and library files supplied as input to or produced as
+output from the programs of this Package do not automatically fall
+under the copyright of this Package, but belong to whomever generated
+them, and may be sold commercially, and may be aggregated with this
+Package. If such scripts or library files are aggregated with this
+Package via the so-called "undump" or "unexec" methods of producing a
+binary executable image, then distribution of such an image shall
+neither be construed as a distribution of this Package nor shall it
+fall under the restrictions of Paragraphs 3 and 4, provided that you do
+not represent such an executable image as a Standard Version of this
+Package.
+
+7. You may reuse parts of this Package in your own programs, provided that
+you explicitly state where you got them from, in the source code (and, left
+to your courtesy, in the documentation), duplicating all the associated
+copyright notices and disclaimers. Besides your changes, if any, must be
+clearly marked as such. Parts reused that way will no longer fall under this
+license if, and only if, the name of your program(s) have no immediate
+connection with the name of the Package itself or its associated programs.
+You may then apply whatever restrictions you wish on the reused parts or
+choose to place them in the Public Domain--this will apply only within the
+context of your package.
+
+8. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+ The End
--- /dev/null
+Thanks to Matt Simerson <matt@michweb.net> of MichWeb Inc. for documentation
+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 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 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.
+
+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!
+
+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> generously 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.
+
+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';
+
+1;
+__END__
+
+=head1 NAME
+
+FS - Freeside Perl modules
+
+=head1 SYNOPSIS
+
+FS is the unofficial (i.e. non-CPAN) prefix for the Perl module portion of the
+Freeside ISP billing software. This includes:
+
+=head2 Utility classes
+
+L<FS::Conf> - Freeside configuration values
+
+L<FS::UID> - User class (not yet OO)
+
+L<FS::CGI> - Non OO-subroutines for the web interface. This is
+depriciated. Future development will be focused on the FS::UI user-interface
+classes (see below).
+
+=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_referral> - Referral class
+
+L<FS::cust_main_county> - Locale (tax rate) class
+
+L<FS::svc_Common> - Service base class
+
+L<FS::svc_acct> - Account (shell, RADIUS, POP3) class
+
+L<FS::svc_domain> - Domain class
+
+L<FS::domain_record> - DNS zone entries
+
+L<FS::svc_acct_sm> - Vitual mail alias class
+
+L<FS::svc_www> - Web virtual host class.
+
+L<FS::part_svc> - Service definition 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::cust_pay> - Payment class
+
+L<FS::cust_credit> - Credit class
+
+L<FS::cust_refund> - Refund 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
+
+=head2 User Interface classes (under 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."
+
+=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 htdocs/docs.
+
+=head1 VERSION
+
+$Id: FS.pm,v 1.5 2001-04-23 12:40:30 ivan Exp $
+
+=head1 SUPPORT
+
+A mailing list for users and developers is available. Send a blank message to
+<ivan-freeside-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
+
+The version number of the FS Perl extension differs from the version of the
+Freeside distribution, which are both different from the CVS version tag for
+each file, which appears under the VERSION heading.
+
+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);
+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);
+
+=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)=@_;
+
+ my $x = <<END;
+ <HTML>
+ <HEAD>
+ <TITLE>
+ $title
+ </TITLE>
+ </HEAD>
+ <BODY BGCOLOR="#e8e8e8">
+ <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 headers and 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( '-expires' => 'now' );
+ }
+ 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>
+ </BODY>
+</HTML>
+END
+
+}
+
+=item eidiot ERROR
+
+This is depriciated. Don't use it.
+
+Sends headers and an HTML error message, then exits.
+
+=cut
+
+sub eidiot {
+ warn "eidiot depriciated";
+ idiot(@_);
+ if (exists $ENV{MOD_PERL}) {
+ 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%">!;
+ } else {
+ "<TABLE BORDER=1>";
+ }
+}
+
+=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>";
+ }
+
+}
+
+=back
+
+=head1 BUGS
+
+Not OO.
+
+Not complete.
+
+=head1 SEE ALSO
+
+L<CGI>, L<CGI::Base>
+
+=cut
+
+1;
+
+
--- /dev/null
+package FS::CGIwrapper;
+
+use vars qw(@ISA);
+
+use CGI;
+
+@ISA = qw( CGI );
+
+sub header {
+ my $self = shift;
+ $self->SUPER::header(
+ @_,
+ '-expires' => 'now',
+ '-pragma' => 'No-Cache',
+ '-cache-control' => 'No-Cache',
+ );
+}
--- /dev/null
+package FS::Conf;
+
+use vars qw($default_dir);
+use IO::File;
+
+=head1 NAME
+
+FS::Conf - Read access to 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');
+
+=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. 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;
+}
+
+=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 (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
+
+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
+
+Write access (with locking) should be implemented.
+
+=head1 SEE ALSO
+
+config.html from the base documentation contains a list of configuration files.
+
+=cut
+
+1;
--- /dev/null
+package FS::Record;
+
+use strict;
+use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG);
+use subs qw(reload_dbdef);
+use Exporter;
+use Carp qw(carp cluck croak confess);
+use File::CounterFile;
+use DBIx::DBSchema;
+use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name);
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
+
+$DEBUG = 0;
+
+#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; #depriciated
+
+ $error = $record->delete;
+ #$error = $record->del; #depriciated
+
+ $error = $new_record->replace($old_record);
+ #$error = $new_record->rep($old_record); #depriciated
+
+ $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'; #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);
+
+ $self->{'Table'} = shift unless defined ( $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;
+}
+
+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
+
+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($table, $record, $select, $extra_sql ) = @_;
+ $table =~ /^([\w\_]+)$/ or die "Illegal table: $table";
+ $table = $1;
+ $select ||= '*';
+ my $dbh = dbh;
+
+ my @fields = grep exists($record->{$_}), fields($table);
+
+ my $statement = "SELECT $select FROM $table";
+ if ( @fields ) {
+ $statement .= ' WHERE '. join(' AND ', map {
+ if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
+ if ( driver_name =~ /^Pg$/i ) {
+ "$_ IS NULL";
+ } else {
+ qq-( $_ IS NULL OR $_ = "" )-;
+ }
+ } else {
+ "$_ = ?";
+ }
+ } @fields );
+ }
+ $statement .= " $extra_sql" if defined($extra_sql);
+
+ warn $statement if $DEBUG;
+ my $sth = $dbh->prepare($statement)
+ or croak "$dbh->errstr doing $statement";
+
+ $sth->execute( map $record->{$_},
+ grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
+ ) or croak $dbh->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
+ 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 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 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 {
+ 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
+
+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 {
+ $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 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);
+
+ my @fields =
+ grep defined($self->getfield($_)) && $self->getfield($_) ne "",
+ $self->fields
+ ;
+
+ my $statement = "INSERT INTO ". $self->table. " ( ".
+ join(', ',@fields ).
+ ") VALUES (".
+ join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
+ ")"
+ ;
+ my $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';
+ local $SIG{PIPE} = 'IGNORE';
+
+ $sth->execute or return $sth->errstr;
+ 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
+ );
+ my $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';
+ 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";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
+
+ 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 );
+
+ my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+ unless ( @diff ) {
+ carp "warning: records identical";
+ return '';
+ }
+
+ 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 $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 )
+ )
+ ;
+ my $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';
+ 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";
+ 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!";
+}
+
+=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);
+
+ &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->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)=@_;
+ $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
+ or return "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 "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' ) {
+ $phonen =~ s/\D//g;
+ $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
+ or return "Illegal (phone) $field: ". $self->getfield($field);
+ $phonen = "$1-$2-$3";
+ $phonen .= " x$4" if $4;
+ $self->setfield($field,$phonen);
+ } else {
+ warn "don't know how to check phone numbers for country $country";
+ return $self->ut_alphan($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);
+ '';
+}
+
+=cut
+
+=item ut_anything COLUMN
+
+Untaints arbitrary data. Be careful.
+
+=cut
+
+sub ut_anything {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^(.*)$/
+ or return "Illegal $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+
+=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);
+ croak "Unknown table $table" unless $table_obj;
+ $table_obj->columns;
+}
+
+=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;
+}
+
+=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<FS::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 "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 VERSION
+
+$Id: Record.pm,v 1.17 2001-06-03 11:27:00 ivan Exp $
+
+=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 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 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.
+
+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)
+
+=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::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 swapuid cgisuidsetup
+ adminsuidsetup 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 swapuid);
+
+ 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 {
+
+ $user = shift;
+ croak "fatal: adminsuidsetup called without arguements" unless $user;
+
+ $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->disconnect if $dbh;
+ $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
+ 'AutoCommit' => 0,
+ 'ChopBlanks' => 1,
+ } ) or die "DBI->connect error: $DBI::errstr\n";
+
+ swapuid(); #go to non-privledged user if running setuid freeside
+
+ 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";
+ }
+ $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 swapuid
+
+Swaps real and effective UIDs.
+
+=cut
+
+sub swapuid {
+ ($<,$>) = ($>,$<) if $< != $>;
+}
+
+=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 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.6 2001-04-23 09:00:06 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 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 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.2 2000-12-03 13:45:15 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 $invoice_template $money_char );
+use vars qw( $invoice_lines @buf ); #yuck
+use Date::Format;
+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;
+
+@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') || '$';
+
+ my @invoice_template = $conf->config('invoice_template')
+ or die "cannot load config file invoice_template";
+ $invoice_lines = 0;
+ foreach ( grep /invoice_lines\(\d+\)/, @invoice_template ) { #kludgy
+ /invoice_lines\((\d+)\)/;
+ $invoice_lines += $1;
+ }
+ die "no invoice_lines() functions in template?" unless $invoice_lines;
+ $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";
+};
+
+=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;
+
+ @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 - how many times this invoice has been printed automatically
+(see L<FS::cust_main/"collect">).
+
+=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 {
+ return "Can't remove invoice!"
+}
+
+=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')
+ ;
+ 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_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 = 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
+
+Returns all payments (see L<FS::cust_pay>) for this invoice.
+
+=cut
+
+sub cust_pay {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
+ ;
+}
+
+=item owed
+
+Returns the amount owed (still outstanding) on this invoice, which is charged
+minus all payments (see L<FS::cust_pay>).
+
+=cut
+
+sub owed {
+ my $self = shift;
+ my $balance = $self->charged;
+ $balance -= $_->paid foreach ( $self->cust_pay );
+ $balance;
+}
+
+=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 ) = ( shift, shift );
+ $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 @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 ( @cr_cust_credit ) {
+ push @buf,[
+ "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
+ $money_char. sprintf("%10.2f",$_->credited)
+ ];
+ }
+
+ #get & print payments
+ foreach ( $self->cust_pay ) {
+ push @buf,[
+ "Payment received ". time2str("%x",$_->_date ),
+ $money_char. sprintf("%10.2f",$_->paid )
+ ];
+ }
+
+ #balance due
+ push @buf,['','-----------'];
+ push @buf,['Balance Due', $money_char.
+ sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) ];
+
+ #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;
+
+ $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;
+
+
+ #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;
+ map {
+ scalar(@buf) ? shift @buf : [ '', '' ];
+ }
+ ( 1 .. $lines );
+ }
+
+ $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.7 2001-04-09 23:05:15 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_pay>, L<FS::cust_bill_pkg>,
+L<FS::cust_credit>, 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
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_bill_pkg.pm,v 1.2 2001-02-11 17:34:44 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 );
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::cust_refund;
+
+@ISA = qw( FS::Record );
+
+=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
+
+=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.
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ return "Can't remove credit!"
+}
+
+=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');
+ ;
+ return $error if $error;
+
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->_date(time) unless $self->_date;
+
+ $self->otaker(getotaker);
+
+ ''; #no error
+}
+
+=item cust_refund
+
+Returns all refunds (see L<FS::cust_refund>) for this credit.
+
+=cut
+
+sub cust_refund {
+ my $self = shift;
+ sort { $a->_date <=> $b->_date }
+ qsearch( 'cust_refund', { 'crednum' => $self->crednum } )
+ ;
+}
+
+=item credited
+
+Returns the amount of this credit that is still outstanding; which is
+amount minus all refunds (see L<FS::cust_refund>).
+
+=cut
+
+sub credited {
+ my $self = shift;
+ my $amount = $self->amount;
+ $amount -= $_->refund foreach ( $self->cust_refund );
+ $amount;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_credit.pm,v 1.6 2001-04-23 19:50:07 ivan Exp $
+
+=head1 BUGS
+
+The delete method.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
+documentation.
+
+=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 $conf $lpr $processor $xaction $E_NoErr $invoice_from
+ $smtpmachine $Debug );
+use Safe;
+use Carp;
+use Time::Local;
+use Date::Format;
+#use Date::Manip;
+use Mail::Internet;
+use Mail::Header;
+use Business::CreditCard;
+use FS::UID qw( getotaker dbh );
+use FS::Record qw( qsearchs qsearch );
+use FS::cust_pkg;
+use FS::cust_bill;
+use FS::cust_bill_pkg;
+use FS::cust_pay;
+use FS::cust_credit;
+use FS::cust_pay_batch;
+use FS::part_referral;
+use FS::cust_main_county;
+use FS::agent;
+use FS::cust_main_invoice;
+use FS::prepay_credit;
+
+@ISA = qw( FS::Record );
+
+$Debug = 0;
+#$Debug = 1;
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_main'} = sub {
+ $conf = new FS::Conf;
+ $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('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 = 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;
+
+ $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 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>)
+
+=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
+
+Adds this customer to the database. If there is an error, returns the error,
+otherwise returns false.
+
+There is a special insert mode in which you pass a data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects. When
+running under a transactional database, all records are inserted atomicly, or
+the transaction is rolled back. 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 );
+
+=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 $error;
+ }
+ }
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( @param ) {
+ 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 $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 $error;
+ }
+ }
+ }
+ }
+
+ if ( $seconds ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "No svc_acct record to apply pre-paid time";
+ }
+
+ 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 $error;
+ }
+ }
+
+ $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 packages, you need to pass a new (valid) customer
+number for those packages to be transferred to.
+
+You can't delete a customer with invoices (see L<FS::cust_bill>),
+or credits (see L<FS::cust_credit>).
+
+=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";
+ }
+
+ my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+ 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;
+ }
+ }
+ }
+ foreach my $cust_main_invoice (
+ 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
+
+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 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;
+
+ my $error =
+ $self->ut_numbern('custnum')
+ || $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_textn('state')
+ ;
+ #barf. need message catalogs. i18n. etc.
+ $error .= "Please select a referral."
+ if $error =~ /^Illegal or empty \(numeric\) refnum: /;
+ 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->getfield('last');
+ $self->setfield('last',$1);
+
+ $self->first =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal first name: ". $self->first;
+ $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;
+ $self->ss("$1-$2-$3");
+ }
+
+ $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
+ $self->country($1);
+ 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)
+ ;
+ return $error if $error;
+
+ $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/
+ or return "Illegal zip: ". $self->zip;
+ $self->zip($1);
+
+ $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 "Illegal credit card number: ". $self->payinfo;
+ $payinfo = $1;
+ $self->payinfo($payinfo);
+ validate($payinfo)
+ or return "Illegal credit card number: ". $self->payinfo;
+ return "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;
+ 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;
+ $self->payname($1);
+ }
+
+ $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->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 = shift;
+ 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;
+ @{ [ # force list context
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => '',
+ }),
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => 0,
+ }),
+ ] };
+}
+
+=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'} || 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 @cust_bill_pkg;
+
+ foreach my $cust_pkg (
+ qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
+ ) {
+
+ 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 = new FS::cust_pkg \%hash;
+
+ # bill setup
+ my $setup = 0;
+ unless ( $cust_pkg->setup ) {
+ my $setup_prog = $part_pkg->getfield('setup');
+ $setup_prog =~ /^(.*)$/ #presumably trusted
+ or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $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);
+ 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');
+ $recur_prog =~ /^(.*)$/ #presumably trusted
+ or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
+ $recur_prog = $1;
+ 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? CAREFUL with timezones (see
+ # mailing list archive)
+ #$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 undefined" unless defined($setup);
+ warn "recur is undefined" unless defined($recur);
+ warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
+
+ if ( $cust_pkg_mod_flag ) {
+ $error=$cust_pkg->replace($old_cust_pkg);
+ if ( $error ) { #just in case
+ warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
+ } else {
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ 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;
+ }
+ }
+
+ }
+
+ my $charged = sprintf( "%.2f", $total_setup + $total_recur );
+
+ unless ( @cust_bill_pkg ) {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ unless ( $self->getfield('tax') =~ /Y/i
+ || $self->getfield('payby') eq 'COMP'
+ ) {
+ my $cust_main_county = qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ } );
+ my $tax = sprintf( "%.2f",
+ $charged * ( $cust_main_county->getfield('tax') / 100 )
+ );
+ $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->getfield('custnum'),
+ '_date' => $time,
+ 'charged' => $charged,
+ } );
+ $error = $cust_bill->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error for customer #". $self->custnum;
+ }
+
+ 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?
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "$error for customer #". $self->custnum;
+ }
+ }
+
+ $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').
+
+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'} || 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 $total_owed = $self->balance;
+ warn "collect: total owed $total_owed " if $Debug;
+ unless ( $total_owed > 0 ) { #redundant?????
+ $dbh->rollback if $oldAutoCommit;
+ return '';
+ }
+
+ foreach my $cust_bill (
+ qsearch('cust_bill', { 'custnum' => $self->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)" if $Debug;
+
+ next unless $amount > 0;
+
+ if ( $self->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
+ ) {
+
+ #my @print_text = $cust_bill->print_text; #( date )
+ my @invoicing_list = $self->invoicing_list;
+ if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
+ $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' => [ $cust_bill->print_text ], #( date)
+ );
+ $message->smtpsend or die "Can't send invoice email!"; #die? warn?
+
+ } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
+ open(LPR, "|$lpr") or die "Can't open pipe to $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 = new FS::cust_bill(\%hash);
+ my $error = $new_cust_bill->replace($cust_bill);
+ warn "Error updating $cust_bill->printed: $error" if $error;
+
+ }
+
+ } elsif ( $self->payby eq 'COMP' ) {
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'COMP',
+ 'payinfo' => $self->payinfo,
+ 'paybatch' => ''
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
+ }
+
+
+ } elsif ( $self->payby eq 'CARD' ) {
+
+ if ( $options{'batch_card'} ne 'yes' ) {
+
+ unless ( $processor ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Real time card processing not enabled!";
+ }
+
+ if ( $processor =~ /^cybercash/ ) {
+
+ #fix exp. date for cybercash
+ #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ my $exp = "$2/$1";
+
+ my $paybatch = $cust_bill->invnum.
+ '-' . time2str("%y%m%d%H%M%S", time);
+
+ my $payname = $self->payname ||
+ $self->getfield('first'). ' '. $self->getfield('last');
+
+ my $address = $self->address1;
+ $address .= ", ". $self->address2 if $self->address2;
+
+ my $country = 'USA' if $self->country eq 'US';
+
+ 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 {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown real-time processor $processor";
+ }
+
+ #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 = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'CARD',
+ 'payinfo' => $self->payinfo,
+ 'paybatch' => "$processor:$paybatch",
+ } );
+ my $error = $cust_pay->insert;
+ if ( $error ) {
+ # gah, even with transactions.
+ $dbh->commit if $oldAutoCommit; #well.
+ my $e = 'WARNING: Card debited but database not updated - '.
+ 'error applying payment, invnum #' . $cust_bill->invnum.
+ " (CyberCash Order-ID $paybatch): $error";
+ warn $e;
+ return $e;
+ }
+ } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
+ || $options{'report_badcard'} ) {
+ $dbh->commit if $oldAutoCommit;
+ return 'Cybercash error, invnum #' .
+ $cust_bill->invnum. ':'. $result{'MErrMsg'};
+ } else {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ } else {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown real-time processor $processor\n";
+ }
+
+ } else { #batch card
+
+ my $cust_pay_batch = new FS::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;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error adding to cust_pay_batch: $error";
+ }
+
+ }
+
+ } else {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown payment type ". $self->payby;
+ }
+
+ }
+ $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>).
+
+=cut
+
+sub total_owed {
+ my $self = shift;
+ my $total_bill = 0;
+ foreach my $cust_bill ( qsearch('cust_bill', {
+ 'custnum' => $self->custnum,
+ } ) ) {
+ $total_bill += $cust_bill->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 = 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 balance
+
+Returns the balance for this customer (total owed minus total credited).
+
+=cut
+
+sub balance {
+ my $self = shift;
+ sprintf( "%.2f", $self->total_owed - $self->total_credited );
+}
+
+=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 = ();
+ }
+ foreach my $address ( @{$arrayref} ) {
+ unless ( grep { $address eq $_->address } @cust_main_invoice ) {
+ 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;
+ }
+ '';
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_main.pm,v 1.14 2001-06-03 10:51:54 ivan Exp $
+
+=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.
+
+CyberCash v2 forces us to define some variables in package main.
+
+There should probably be a configuration file with a list of allowed credit
+card types.
+
+CyberCash is the only processor.
+
+No multiple currency support (probably a larger project than just this module).
+
+=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::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 );
+use FS::Record;
+
+@ISA = qw( FS::Record );
+
+=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;
+
+=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
+
+=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->ut_numbern('taxnum')
+ || $self->ut_textn('state')
+ || $self->ut_textn('county')
+ || $self->ut_text('country')
+ || $self->ut_float('tax')
+ ;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_main_county.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+=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 $mydomain);
+use Exporter;
+use FS::Record qw( qsearchs );
+use FS::Conf;
+use FS::cust_main;
+use FS::svc_acct;
+
+@ISA = qw( FS::Record );
+
+#ask FS::UID to run this stuff for us later
+$FS::UID::callback{'FS::cust_main_invoice'} = sub {
+ $conf = new FS::Conf;
+ $mydomain = $conf->config('domain');
+};
+
+=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;
+}
+
+
+=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.
+
+=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)"
+ 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 (specified literally)" unless $svc_acct;
+ $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!";
+ $self->dest($1);
+ }
+ } else {
+ return "Illegal destination!";
+ }
+
+ ''; #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 } );
+ $svc_acct->username . '@' . $mydomain;
+ } else {
+ $self->dest;
+ }
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_main_invoice.pm,v 1.2 2000-06-20 07:13:03 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 );
+use Business::CreditCard;
+use FS::Record qw( qsearchs );
+use FS::cust_bill;
+
+@ISA = qw( FS::Record );
+
+=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 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 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 databse, and updates the invoice (see
+L<FS::cust_bill>).
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
+ return "Unknown invnum" unless $old_cust_bill;
+
+ $self->SUPER::insert;
+}
+
+=item delete
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub delete {
+ return "Can't (yet?) delete cust_pay records!";
+}
+
+=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;
+
+ $error =
+ $self->ut_numbern('paynum')
+ || $self->ut_number('invnum')
+ || $self->ut_money('paid')
+ || $self->ut_numbern('_date')
+ ;
+ return $error if $error;
+
+ $self->_date(time) unless $self->_date;
+
+ $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;
+ $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;
+ }
+
+ $error = $self->ut_textn('paybatch');
+ return $error if $error;
+
+ ''; #no error
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pay.pm,v 1.3 2001-04-09 23:05:15 ivan Exp $
+
+=head1 BUGS
+
+Delete and replace methods.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<FS::cust_bill>, 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 trancode - 77 for charges
+
+=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('trancode')
+ || $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_text('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);
+
+ #check invnum, custnum, ?
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pay_batch.pm,v 1.2 2000-06-17 21:48:05 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;
+
+@ISA = qw( FS::Record );
+
+=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;
+
+ $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 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.
+
+sub insert {
+ my $self = shift;
+
+ # custnum might not have have been defined in sub check (for one-shot new
+ # customers), so check it here instead
+
+ my $error = $self->ut_number('custnum');
+ return $error if $error
+
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+
+ $self->SUPER::insert;
+
+}
+
+=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.
+
+=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;
+ 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"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+ }
+
+ return "Unknown 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);
+
+ ''; #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;
+ qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=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 ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+}
+
+=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 $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::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} ) {
+ 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 })
+ ];
+ }
+
+ #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
+# my($pkgnum);
+ foreach $pkgnum ( @{$remove_pkgnums} ) {
+ my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ unless ( $old ) {
+ $dbh->rollback if $oldAutoCommit;
+ die "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;
+ die "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;
+ die "Couldn't insert new cust_pkg record: $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) = new FS::cust_svc ( \%hash );
+ my($error)=$new->replace($cust_svc);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die "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.5 2001-04-09 23:05:15 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.
+
+=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 );
+use FS::UID qw(getotaker);
+use FS::cust_credit;
+
+@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 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 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, and updates the credit (see
+L<FS::cust_credit>).
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $error = $self->check;
+ return $error if $error;
+
+ my $old_cust_credit =
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
+ return "Unknown crednum" unless $old_cust_credit;
+
+ $self->SUPER::insert;
+}
+
+=item delete
+
+Currently unimplemented (accounting reasons).
+
+=cut
+
+sub delete {
+ return "Can't (yet?) delete cust_refund records!";
+}
+
+=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;
+
+ $error =
+ $self->ut_number('refundnum')
+ || $self->ut_number('crednum')
+ || $self->ut_money('amount')
+ || $self->ut_numbern('_date')
+ ;
+ return $error if $error;
+
+ $self->_date(time) unless $self->_date;
+
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
+
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $self->payinfo($payinfo =~ s/\D//g);
+ 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.3 2001-04-09 23:05:15 ivan 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( qsearchs );
+use FS::cust_pkg;
+use FS::part_pkg;
+use FS::part_svc;
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+
+@ISA = qw( FS::Record );
+
+=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_acct_sm>, 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.
+
+=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;
+
+ return "Unknown pkgnum"
+ unless ! $self->pkgnum
+ || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+
+ return "Unknown svcpart" unless
+ qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+
+ ''; #no error
+}
+
+=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 $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+ my $svcdb = $part_svc->svcdb;
+ my $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
+ my $svc = $part_svc->svc;
+ my $tag;
+ if ( $svcdb eq 'svc_acct' ) {
+ $tag = $svc_x->getfield('username');
+ } 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_domain' ) {
+ $tag = $svc_x->getfield('domain');
+ } else {
+ cluck "warning: asked for label of unsupported svcdb; using svcnum";
+ $tag = $svc_x->getfield('svcnum');
+ }
+ $svc, $tag, $svcdb;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_svc.pm,v 1.1 1999-08-04 09:03:53 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::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\.\-]+)$/
+ 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)$/
+ or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
+ $self->rectype;
+ $self->rectype($1);
+
+ if ( $self->rectype eq 'SOA' ) {
+ my $recdata = $self->recdata;
+ $recdata =~ s/\s+/ /g;
+ $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/
+ or return "Illegal data for SOA record: $recdata";
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'NS' ) {
+ $self->recdata =~ /^([a-z0-9\.\-]+)$/
+ or return "Illegal data for NS record: ". $self->recdata;
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'MX' ) {
+ $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/
+ 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\.\-]+)$/
+ or return "Illegal data for PTR record: ". $self->recdata;
+ $self->recdata($1);
+ } elsif ( $self->rectype eq 'CNAME' ) {
+ $self->recdata =~ /^([a-z0-9\.\-]+)$/
+ or return "Illegal data for CNAME record: ". $self->recdata;
+ $self->recdata($1);
+ } else {
+ die "ack!";
+ }
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: domain_record.pm,v 1.2 2001-05-18 14:08:55 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.
+
+=head1 HISTORY
+
+$Log: domain_record.pm,v $
+Revision 1.2 2001-05-18 14:08:55 ivan
+tyop
+
+Revision 1.1 2000/02/03 05:16:52 ivan
+beginning of DNS and Apache support
+
+
+=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.5 2001-04-15 13:35:12 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+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 );
+use FS::pkg_svc;
+
+@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
+
+=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 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.
+
+=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;
+
+ $self->ut_numbern('pkgpart')
+ || $self->ut_text('pkg')
+ || $self->ut_text('comment')
+ || $self->ut_anything('setup')
+ || $self->ut_number('freq')
+ || $self->ut_anything('recur')
+ ;
+}
+
+=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;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: part_pkg.pm,v 1.2 1999-08-20 08:27:06 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_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 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 new HASHREF
+
+Creates a new referral. To add the referral to the database, see L<"insert">.
+
+=cut
+
+sub table { 'part_referral'; }
+
+=item insert
+
+Adds this referral 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 referral. 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 VERSION
+
+$Id: part_referral.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+The delete method is unimplemented.
+
+=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( fields );
+
+@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_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_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 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
+
+Adds this service definition to the database. If there is an error, returns
+the error, otherwise returns false.
+
+=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
+
+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 svcdb!"
+ unless $old->svcdb eq $new->svcdb;
+
+ $new->SUPER::replace( $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 = shift;
+ my $recref = $self->hashref;
+
+ my $error;
+ $error=
+ $self->ut_numbern('svcpart')
+ || $self->ut_text('svc')
+ || $self->ut_alpha('svcdb')
+ ;
+ return $error if $error;
+
+ my @fields = eval { fields( $recref->{svcdb} ) }; #might die
+ return "Unknown svcdb!" unless @fields;
+
+ 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
+}
+
+=back
+
+=head1 VERSION
+
+$Id: part_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=head1 BUGS
+
+Delete is unimplemented.
+
+The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this
+should be fixed.
+
+=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.
+
+=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',
+ };
+
+ $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
+
+=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')
+ ;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: prepay_credit.pm,v 1.2 2000-02-02 20:22:18 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=head1 HISTORY
+
+$Log: prepay_credit.pm,v $
+Revision 1.2 2000-02-02 20:22:18 ivan
+bugfix prepayment in signup server
+
+Revision 1.1 2000/01/31 05:22:23 ivan
+prepaid "internet cards"
+
+
+=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);
+ }
+
+ $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 = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } );
+ $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 = qsearchs( 'cust_svc', { 'svcnum' => $self->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 default/fixed/whatever fields from part_svc
+ foreach my $field ( fields('svc_acct') ) {
+ if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq $x ) {
+ $self->setfield( $field, $part_svc->getfield('svc_acct__'. $field) );
+ }
+ }
+
+ $part_svc;
+
+}
+
+=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.4 2001-04-22 00:49:30 ivan Exp $
+
+=head1 BUGS
+
+The setfixed method return value.
+
+The new method should set defaults from part_svc (like the check method
+sets fixed values)?
+
+=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 $nossh_hack $conf $dir_prefix @shells $usernamemin
+ $usernamemax $passwordmin $username_letter $username_letterfirst
+ $shellmachine $useradd $usermod $userdel
+ @saltset @pw_set);
+use Carp;
+use FS::Conf;
+use FS::Record qw( qsearch qsearchs fields );
+use FS::svc_Common;
+use Net::SSH qw(ssh);
+use FS::part_svc;
+use FS::svc_acct_pop;
+use FS::svc_acct_sm;
+
+@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');
+ $shellmachine = $conf->config('shellmachine');
+ $usernamemin = $conf->config('usernamemin') || 2;
+ $usernamemax = $conf->config('usernamemax');
+ $passwordmin = $conf->config('passwordmin') || 6;
+ if ( $shellmachine ) {
+ if ( $conf->exists('shellmachine-useradd') ) {
+ $useradd = join("\n", $conf->config('shellmachine-useradd') )
+ || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
+ } else {
+ $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
+ }
+ if ( $conf->exists('shellmachine-userdel') ) {
+ $userdel = join("\n", $conf->config('shellmachine-userdel') )
+ || 'rm -rf $dir';
+ } else {
+ $userdel = 'userdel $username';
+ }
+ $usermod = join("\n", $conf->config('shellmachine-usermod') )
+ || '[ -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'.
+ ')';
+ }
+ $username_letter = $conf->exists('username-letter');
+ $username_letterfirst = $conf->exists('username-letterfirst');
+};
+
+@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 = 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;
+
+=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 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 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.
+
+If the configuration value (see L<FS::Conf>) shellmachine exists, and the
+username, uid, and dir fields are defined, the command(s) specified in
+the shellmachine-useradd configuration are exectued on shellmachine via ssh.
+This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
+If the shellmachine-useradd configuration file does not exist,
+
+ useradd -d $dir -m -s $shell -u $uid $username
+
+is the default. If the shellmachine-useradd configuration file exists but
+it empty,
+
+ cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
+
+is the default instead. Otherwise the contents of the file are treated as
+a double-quoted perl string, with the following variables available:
+$username, $uid, $gid, $dir, and $shell.
+
+=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 "Username ". $self->username. " in use"
+ if qsearchs( 'svc_acct', { 'username' => $self->username } );
+
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
+ return "Unknown 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$/
+ ;
+
+ $error = $self->SUPER::insert;
+ return $error if $error;
+
+ my( $username, $uid, $gid, $dir, $shell ) = (
+ $self->username,
+ $self->uid,
+ $self->gid,
+ $self->dir,
+ $self->shell,
+ );
+ if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
+ ssh("root\@$shellmachine", eval qq("$useradd") );
+ }
+
+ ''; #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(s) specified in the shellmachine-userdel configuration file are
+executed on shellmachine via ssh. This behavior can be surpressed by setting
+$FS::svc_acct::nossh_hack true. If the shellmachine-userdel configuration
+file does not exist,
+
+ userdel $username
+
+is the default. If the shellmachine-userdel configuration file exists but
+is empty,
+
+ rm -rf $dir
+
+is the default instead. Otherwise the contents of the file are treated as a
+double-quoted perl string, with the following variables available:
+$username and $dir.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $error;
+
+ return "Can't delete an account which has mail aliases pointed to it!"
+ if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
+
+ 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->SUPER::delete;
+ return $error if $error;
+
+ my( $username, $dir ) = (
+ $self->username,
+ $self->dir,
+ );
+ if ( $username && $shellmachine && ! $nossh_hack ) {
+ ssh("root\@$shellmachine", eval qq("$userdel") );
+ }
+
+ '';
+}
+
+=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(s) specified in the shellmachine-usermod
+configuraiton file are executed on shellmachine via ssh. This behavior can
+be surpressed by setting $FS::svc-acct::nossh_hack true. If the
+shellmachine-userdel configuration file does not exist or is empty, :
+
+ [ -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
+ )
+
+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 ) = ( shift, shift );
+ my $error;
+
+ return "Username in use"
+ if $old->username ne $new->username &&
+ qsearchs( 'svc_acct', { 'username' => $new->username } );
+
+ 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';
+
+ $error = $new->SUPER::replace($old);
+ return $error if $error;
+
+ my ( $old_dir, $new_dir, $uid, $gid ) = (
+ $old->getfield('dir'),
+ $new->getfield('dir'),
+ $new->getfield('uid'),
+ $new->getfield('gid'),
+ );
+ if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
+ ssh("root\@$shellmachine", eval qq("$usermod") );
+ }
+
+ ''; #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} = '*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;
+
+ my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
+ $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
+ or return "Illegal username";
+ $recref->{username} = $1;
+ if ( $username_letterfirst ) {
+ $recref->{username} =~ /^[a-z]/ or return "Illegal username";
+ } elsif ( $username_letter ) {
+ $recref->{username} =~ /[a-z]/ or return "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->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' ) {
+ 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->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]{$passwordmin,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,34})$/ ) {
+ $recref->{_password} = $1.$3;
+ } elsif ( $recref->{_password} eq '*' ) {
+ $recref->{_password} = '*';
+ } else {
+ return "Illegal 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;
+ map {
+ /^(radius_(.*))$/;
+ my($column, $attrib) = ($1, $2);
+ $attrib =~ s/_/\-/g;
+ ( $attrib, $self->getfield($column) );
+ } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
+}
+
+=item radius_check
+
+Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
+check attributes of this record.
+
+Accessing RADIUS attributes directly is not supported and will break in the
+future.
+
+=cut
+
+sub radius_check {
+ my $self = shift;
+ map {
+ /^(rc_(.*))$/;
+ my($column, $attrib) = ($1, $2);
+ $attrib =~ s/_/\-/g;
+ ( $attrib, $self->getfield($column) );
+ } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
+}
+
+=cut
+
+=head1 VERSION
+
+$Id: svc_acct.pm,v 1.17 2001-06-03 12:36:10 ivan Exp $
+
+=head1 BUGS
+
+The bits which ssh should fork before doing so (or maybe queue jobs for a
+daemon).
+
+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.
+
+=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::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 );
+use FS::Record qw( qsearchs );
+
+@ISA = qw( FS::Record );
+
+=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;
+
+=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')
+ ;
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_acct_pop.pm,v 1.2 2000-01-28 22:55:06 ivan Exp $
+
+=head1 BUGS
+
+It should be renamed to part_pop.
+
+=head1 SEE ALSO
+
+L<FS::Record>, L<svc_acct>, 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 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 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.3 2001-04-22 01:56:15 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::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 $mydomain $smtpmachine
+ $tech_contact $from $to @nameservers @nameserver_ips @template
+ @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine
+ $soarefresh $soaretry
+);
+use Carp;
+use Mail::Internet;
+use Mail::Header;
+use Date::Format;
+use Net::Whois 1.0;
+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;
+
+@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;
+
+ $mydomain = $conf->config('domain');
+ $smtpmachine = $conf->config('smtpmachine');
+
+ my($internic)="/registries/internic";
+ $tech_contact = $conf->config("$internic/tech_contact");
+ $from = $conf->config("$internic/from");
+ $to = $conf->config("$internic/to");
+ my(@ns) = $conf->config("$internic/nameservers");
+ @nameservers=map {
+ /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
+ or die "Illegal line in $internic/nameservers";
+ $1;
+ } @ns;
+ @nameserver_ips=map {
+ /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
+ or die "Illegal line in $internic/nameservers!";
+ $1;
+ } @ns;
+ @template = map { $_. "\n" } $conf->config("$internic/template");
+
+ @mxmachines = $conf->config('mxmachines');
+ @nsmachines = $conf->config('nsmachines');
+ $soadefaultttl = $conf->config('soadefaultttl');
+ $soaemail = $conf->config('soaemail');
+ $soaexpire = $conf->config('soaexpire');
+ $soamachine = $conf->config('soamachine');
+ $soarefresh = $conf->config('soarefresh');
+ $soaretry = $conf->config('soaretry');
+
+};
+
+=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
+
+=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 machines are defined in the I<nsmachines> configuration file, NS
+records are added to the domain_record table (see L<FS::domain_record>).
+
+If any machines are defined in the I<mxmachines> configuration file, MX
+records are added to the domain_record table (see L<FS::domain_record>).
+
+Any problems adding FS::domain_record records will emit warnings, but will
+not return errors from this method. If your configuration files are correct
+you shouln't have any problems.
+
+=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%e", 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 $nsmachine ( @nsmachines ) {
+ my $ns = new FS::domain_record {
+ 'svcnum' => $self->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => 'NS',
+ 'recdata' => $nsmachine,
+ };
+ my $error = $ns->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "couldn't insert NS record for new domain: $error";
+ }
+ }
+
+ foreach my $mxmachine ( @mxmachines ) {
+ my $mx = new FS::domain_record {
+ 'svcnum' => $self->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => 'MX',
+ 'recdata' => $mxmachine,
+ };
+ my $error = $mx->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "couldn't insert MX record for new domain: $error";
+ }
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #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.
+
+=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 $error;
+
+ my $x = $self->setfixed;
+ return $x unless ref($x);
+ my $part_svc = $x;
+
+ #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]->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
+
+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;
+
+ 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 VERSION
+
+$Id: svc_domain.pm,v 1.11 2001-05-22 16:43:28 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_www;
+
+use strict;
+use vars qw(@ISA $conf $apacheroot $apachemachine $nossh_hack );
+#use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearchs );
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::domain_record;
+use FS::svc_acct;
+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');
+};
+
+=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;
+
+ $error = $self->SUPER::insert;
+ return $error if $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"
+ );
+ }
+
+ '';
+}
+
+=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;
+
+ my $error =
+ $self->ut_numbern('svcnum')
+ || $self->ut_number('recnum')
+ || $self->ut_number('usersvc')
+ ;
+ return $error if $error;
+
+ return "Unknown recnum: ". $self->recnum
+ unless qsearchs('domain_record', { 'recnum' => $self->recnum } );
+
+ return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc
+ unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_www.pm,v 1.4 2001-04-22 01:56:15 ivan Exp $
+
+=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.
+
+=head1 HISTORY
+
+$Log: svc_www.pm,v $
+Revision 1.4 2001-04-22 01:56:15 ivan
+get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)
+
+Revision 1.3 2000/11/22 23:30:51 ivan
+tyop
+
+Revision 1.2 2000/03/01 08:13:59 ivan
+compilation bugfixes
+
+Revision 1.1 2000/02/03 05:16:52 ivan
+beginning of DNS and Apache support
+
+
+=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
+FS.pm
+FS/CGI.pm
+FS/Conf.pm
+FS/Record.pm
+FS/UI/Base.pm
+FS/UI/CGI.pm
+FS/UI/Gtk.pm
+FS/UI/agent.pm
+FS/UID.pm
+FS/agent.pm
+FS/agent_type.pm
+FS/cust_bill.pm
+FS/cust_bill_pkg.pm
+FS/cust_credit.pm
+FS/cust_main.pm
+FS/cust_main_county.pm
+FS/cust_main_invoice.pm
+FS/cust_pay.pm
+FS/cust_pay_batch.pm
+FS/cust_pkg.pm
+FS/cust_refund.pm
+FS/cust_svc.pm
+FS/part_pkg.pm
+FS/part_referral.pm
+FS/part_svc.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
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+test.pl
+README
+bin/freeside-bill
+bin/freeside-print-batch
+FS/domain_record.pm
+FS/prepay_credit.pm
+FS/svc_www.pm
+FS/CGIwrapper.pm
--- /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 -Tw
+
+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::cust_main;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_a $opt_c $opt_i $opt_d);
+getopts("acid:");
+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)= $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 {
+ unless ( exists $saw{ $_->custnum } && defined $saw{ $_->custnum} ) {
+ $saw{ $_->custnum } = 0; # to avoid 'use of uninitialized value' errors
+ }
+ if (
+ ( $main::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 ($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;
+
+ }
+
+}
+
+# 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 [ i ] ] [ -d 'date' ] [ -b ] user\n";
+}
+
+=head1 NAME
+
+freeside-bill - Command line (crontab, script) interface to customer billing.
+
+=head1 SYNOPSIS
+
+ freeside-bill [ -c [ -a ] [ -i ] ] [ -d 'date' ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+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).
+
+ -a: Call collect even if there isn't a new invoice (probably a bad idea for
+ daily use)
+
+ -i: real-time billing (as opposed to batch billing). only relevant
+ for credit cards.
+
+ -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 VERSION
+
+$Id: freeside-bill,v 1.6 2000-06-24 00:28:30 ivan Exp $
+
+=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 Getopt::Std;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_pay;
+use FS::cust_pay_batch;
+
+# Get the currennt time and date
+my $time = time;
+my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($time) )[0,1,2,3,4,5];
+my $_date =
+ timelocal($sec,$min,$hour,$mday,$mon,$year);
+
+# Set the mail program
+my $mail_program = "/usr/sbin/sendmail -t -n";
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_v $opt_p $opt_e $opt_a $opt_d);
+getopts("vpead"); #switches
+
+# 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(@batch)=qsearch('cust_pay_batch',{});
+if (scalar(@batch) == 0)
+{
+ exit 1;
+}
+
+# Open print and email pipes
+# $lpr and opt_p for printing
+# $email and opt_e for email
+#
+if ($lpr && $main::opt_p)
+{
+ open(LPR, "|$lpr");
+ print LPR qq~C R E D I T C A R D P A Y M E N T S D U E $mon/$mday/$year\n\n~;
+}
+
+if ($email && $main::opt_e)
+{
+ open (MAIL, "|$mail_program");
+ print MAIL <<END
+To: $email
+From: Account Processor
+Subject: CREDIT CARD PAYMENTS DUE
+
+
+C R E D I T C A R D P A Y M E N T S D U E $mon/$mday/$year
+END
+}
+
+# Now I can start looping
+foreach my $cust_pay_batch (@batch)
+{
+ my $state = $cust_pay_batch->getfield('state');
+ my $zip = $cust_pay_batch->getfield('zip');
+ my $amount = $cust_pay_batch->getfield('amount');
+ my $last = $cust_pay_batch->getfield('last');
+ my $address1 = $cust_pay_batch->getfield('address1');
+ my $address2 = $cust_pay_batch->getfield('address2');
+ my $first = $cust_pay_batch->getfield('first');
+ my $city = $cust_pay_batch->getfield('city');
+ my $cardnum = $cust_pay_batch->getfield('cardnum');
+ my $payname = $cust_pay_batch->getfield('payname');
+ my $exp = $cust_pay_batch->getfield('exp');
+ my $invnum = $cust_pay_batch->getfield('invnum');
+ my $custnum = $cust_pay_batch->getfield('custnum');
+
+ # Need a carriage return in address before address2
+ # if it exists. Otherwise address will just be address1
+ my $address = $address1;
+ $address .= "\n$address2" if ($address2);
+
+ # Only print to the screen in verbose mode
+ if ($main::opt_v)
+ {
+ printf("Invoice %d for %s %s\tCustomer Number: %d\n",
+ $invnum,
+ $first,
+ $last,
+ $custnum);
+
+ printf("\t%s\n", $address);
+ printf("\t%s, %s, %s\n\n",
+ $city,
+ $state,
+ $zip);
+
+ printf("\tCard Number: %s\tExp:%s\n",
+ $cardnum,
+ $exp);
+ printf("\t\tName: %s\n", $payname);
+ printf("\t\tAmount: %.2f\n\n\n", $amount);
+ }
+
+ if ($lpr && $main::opt_p)
+ {
+ printf(LPR "Invoice %d for %s %s\tCustomer Number: %d\n",
+ $invnum,
+ $first,
+ $last,
+ $custnum);
+
+ printf(LPR "\t%s\n", $address);
+ printf(LPR "\t%s, %s, %s\n\n",
+ $city,
+ $state,
+ $zip);
+
+ printf(LPR "\tCard Number: %s\tExp:%s\n",
+ $cardnum,
+ $exp);
+ printf(LPR "\t\tName: %s\n", $payname);
+ printf(LPR "\t\tAmount: %.2f\n\n\n", $amount);
+ }
+
+ if ($email && $main::opt_e)
+ {
+ printf(MAIL "Invoice %d for %s %s\tCustomer Number: %d\n",
+ $invnum,
+ $first,
+ $last,
+ $custnum);
+
+ printf(MAIL "\t%s\n", $address);
+ printf(MAIL "\t%s, %s, %s\n\n",
+ $city,
+ $state,
+ $zip);
+
+ printf(MAIL "\tCard Number: %s\tExp:%s\n",
+ $cardnum,
+ $exp);
+ printf(MAIL "\t\tName: %s\n", $payname);
+ printf(MAIL "\t\tAmount: %.2f\n\n\n", $amount);
+ }
+
+ # Now I want to delete the records from cust_pay_batch
+ # and mark the records in cust_pay as paid today if
+ # the delete (-d) command line option is set.
+ if($main::opt_a)
+ {
+ my $payment=new FS::cust_pay {
+ 'invnum' => $invnum,
+ 'paid' => $amount,
+ '_date' => $_date,
+ 'payby' => "CARD",
+ 'payinfo' => $cardnum,
+ 'paybatch' => "AUTO",
+ };
+
+ my $pay_error=$payment->insert;
+ if ($pay_error)
+ {
+ # warn might be better if you get root's mail
+ # NEED TO TEST THIS BEFORE DELETE IF WARN IS USED
+ die "Could not update cust_pay for invnum $invnum. $pay_error\n";
+ }
+ }
+
+ # This just deletes the records
+ # Must be last in the foreach loop
+ if($main::opt_d)
+ {
+ my $del_error = $cust_pay_batch->delete;
+ if ($del_error)
+ {
+ die "Could not delete cust_pay_batch for invnum $invnum. $del_error\n";
+ }
+ }
+
+}
+
+# Now I need to close LPR and EMAIL if they were open
+if($lpr && $main::opt_p)
+{
+ close LPR || die "Could not close printer: $lpr\n";
+}
+
+if($email && $main::opt_e)
+{
+ close MAIL || die "Could not close printer: $lpr\n";
+}
+
+
+# subroutines
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-print-batch [-v] [-p] [-e] [-a] [-d] user\n";
+}
+
+=head1 NAME
+
+freeside-print-batch - Prints or emails cust_pay_batch. Also deletes
+ old records and adds payment to cust_pay.
+ Usually run after the bill command.
+
+=head1 SYNOPSIS
+
+ freeside-print-batch [-v] [-p] [-e] [-a] [-d] user
+
+=head1 DESCRIPTION
+
+Prints or emails cust_pay_batch. Can enter payment and delete
+printed records. Usually run as a cron job.
+
+B<-v>: Verbose - Prints records to STDOUT.
+
+B<-p>: Print to printer lpr as found in the conf directory.
+
+B<-e>: Email output to user found in the Conf email file.
+
+B<-a>: Automatically pays all records in cust_pay_batch. Use -d with this option usually.
+
+B<-d>: Delete - Pays account and deletes record from cust_pay_batch.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-print-batch,v 1.2 2001-02-21 01:48:07 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 HISTORY
+
+griff@aver-computer.com July 99
+
+$Log: freeside-print-batch,v $
+Revision 1.2 2001-02-21 01:48:07 ivan
+stupid pod errors
+
+Revision 1.1 2000/05/13 21:57:56 ivan
+add print_batch script from Joel Griffiths
+
+
+=cut
+
+
--- /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;
+$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
+Freeside 1.3.1
+
+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:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 2, or (at your option) any
+ later version, or
+
+ b) the "Artistic License"
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
+ GNU General Public License or the Artistic License for more details.
+
+ You should have received a copy of the GNU General Public
+ License along with this program, in the file `GPL'; if not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite
+ 330, Boston, MA 02111-1307, USA.
+
+ You should have received a copy of the Artistic License along with
+ this program, in the file `Artistic'; if not, download it from
+ http://www.perl.com/CPAN/doc/misc/license/Artistic
+
+Freeside is a billing and administration package for Internet Service
+Providers.
+
+The Freeside home page is at `http://www.sisd.com/freeside'.
+
+The documentation is in `htdocs/docs'.
+
+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 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
+$Id: TODO,v 1.64 2001-06-03 14:15:52 ivan Exp $
+
+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.
+
+---
+
+"Andrew Wafula" <awafula2000@yahoo.co.uk>:
+> Following my recent questions on money_char, i would like to suggest that
+> money_char be used as well in cust_bill.cgi and cust_main.cgi so that the
+> charges are seen in whatever money_char is used in a particular country
+> instead of the default dollar currecny. This would make it such that the
+> system has one monetary unit in its entirety rather than only for the
+> invoicing part. I guess this would be something others would appreciate as
+> well.
+
+Things that would be nice but probably won't happen: testing with
+MySQL+Sleepycat, a fix for the long-RADIUS-attributes-with Pg problem,
+passive session monitoring with RADIUS (tailing a log file or monitoring a
+database, as opposed to using a RADIUS with proper callbacks).
+
+anything doing transactions in the web interface should likely move into *.pm.
+(transactions are here woo!)
+
+write some sample billing expressions with libcflow-perl :)
+
+(future templating)
+.
+(at least) These questions need to be answered for Mason, Apache::ASP and
+eperl. If eperl becomes too much of a pain, I'm okay with forgetting
+about it - it's not well-maintained. The answers below are for Mason.
+.
+How do you interpolate a value? <% $value %>
+.
+How do you interpolate a value without escaping HTML? <% $value |n %>
+.
+How do you interpolate a (possibly non-stand-alone, non-interpolated)
+control structure? With an inital % - for example:
+.
+ % for each $value ( @values ) {
+ <OPTION><% $value %></OPTION>
+ % }
+.
+This is one of the things I worry that the webmonkey HTML editors will not
+like about Mason. That and the <%INIT> and <%PERL> tags.
+
+
+in the context of a state machine (& MySQL and Pg locking) for LDAP export:
+.
+Also note that Pg locks are for the duration of the transaction, so
+Freeside needs to start using transactions for this to happen.
+FS::UID::adminsuidsetup should explicitly set AutoCommit false and export
+some functions to begin and end transactions on $FS::UID::dbh. (Well,
+eventually FS::UID should be an overloaded subclass of a DBI handle, but
+we don't have to worry about that until perl threads + mod_perl + threaded
+Apache 2.0 is stable, i.e. quite some time).
+
+Postfix
+also supports virtual domains in a way that's somewhat similar (but not
+compatible with) the way sendmail does. In the postfix world, all virtual
+domain info is contained in one file (similar to the virtusertable), but
+is formatted as such:
+bar.com virtual
+foo@bar.com some@other.net
+quux@bar.com localuser1
+...
+and so on. After the file is generated, it gets compiled into a hash db
+using, "postmap /etc/postfix/virtual".
+
+
+steal all the play-nice-with-cache stuff back from RT
+
+Use this for email checking:
+libemail-valid-perl - Check validity of Internet email addresses
+.
+This module determines whether an email address is well-formed, and
+optionally, whether a mail host exists for the domain.
+
+
+wishlist from drenalin@ultimanet.com:
+* delete button for customers
+- 15th of the month billing
+- field for customer referrals (naming who it is) and automatically crediting
++that account
+- ability to edit referrals
+- catch expired credit cards and notify via email when they are expiring
+* show passwords
+- set default shell to /bin/false when adding ppp account
+- import list of POPs from Megapop (see www.ultimanet.com and click on locations
++from text in index page)
+
+
+wishlist wrt projects/consulting from jivko@ijs.com:
+>The other thing, which is the serious part, is the following: We do not
+>offer dial-up services and that part of the system does not have to work,
+>but we have many customer, for which we do both hosting and consulting work.
+.
+>The hosting can be handled by freeside fine, but in the little time I spent
+>on it I could not see how exactly to solve the consulting problem. What I
+>would love to see there is a way to create 'projects' for each customer and
+>ability to follow up on those (I mean to be able to add new comments,
+>descriptions, progress updates etc.). You already have the feature, which
+>allows multiple people to access the system with different access rights so
+>it should be possible to make it keep track of who and when updated given
+>'project' so we could have the developers access the database and update
+>the projects they are working on.
+.
+Hmm. Is this accurate: Each project is related to a single customer, and
+zero or more packages (billing items). Each project has a name, due date,
+and zero or more log entries consisting of date, user, and a text field
+(for "new comments, descriptions, progress updates etc." - would you like
+anything more specific?)
+
+In conjunction with that it looks like you need the ability to create
+"one-off" packages on the fly for arbitrary charges.
+
+> Additionally it would be nice to have a page, where all open projects can
+> be listed and not only that but be able list them by date too. (Say I want
+> to find out which projects are due today or two days from today, or which
+> projects are running late)
+.
+Browse/search project by date and customer.
+.
+> Finally it would be real nice if the billing script could add the cost for
+> all completed projects (or work done by the hour) to the monthly bill along
+> with the hosting information and using the description of the work from the
+> 'project' table.
+.
+Can you be more specific about your needs here?
+.
+> This is a lot of work, unless you disagree :-), and I would not expect you
+> to do all of it - we can work on it too - but I would hope for you to lead
+> the effort.
+.
+I'm trying to get a handle on specifically what you need.
+.
+> Oh, and there is one more thing, but that should be simple to do. I would
+> like to be able to give the customers access to selected information from
+> their account. I want them to be able to monitor the progress of their
+> projects and the status of their accounts.
+.
+Ok.
+.
+> Does all this make sense? It must be close to what you need at your office
+> though or at least I think so.
+.
+Yes, but we're small and have been tracking projects manually.
+.
+.
+>You may have this already .. what I have in mind is the following. Say you
+>have a customer for which you do hosting and some consulting (CGI, JAVA
+>etc) At the end of the month you need to bill the customer for the hosting,
+>35hours of Java programming and 10 hours of HTML authoring. The last two
+>are not because the project is over but because the work was done during
+>that month.
+>
+>So the way I see it, and it could be wrong, is that during the month the
+>people who work on particular project enter their comments and time spent
+>on the project. At the end of the month the billing script generates
+>invoices in which besides the hosting charges there are also charges for
+>work done during the period.
+>
+>Currently we do this in a very stupid way by maintaining a customer file,
+>in which a script saves things to be invoiced. At the end of the month a
+>script goes through these files and generates invoices with all items from
+>the files, which have not been flagged as 'paid'. The convenience of this
+>is that no one needs to worry about the invoices containing the items they
+>need to contain.
+
+
+
+first package select field in edit/cust_main.cgi isn't sticky on errors, yuck
+(also referral isn't sticky either? yuck)
+
+> 1. A Web Form to the user get his account added automatically . The
+> /etc/raddb/users and /etc/passwd would be updated automatically (these
+> file are on the same machine Freeside is). I guess the the Add
+> Customer
+> page with some customization could be the work.
+> 2. A Canceling Account Web Form available to user cancel his account
+> at
+> any time he wants.
+> 3. A Password Changing Web Form where the user could change your
+> password by sending your username, old and new password.
+> 4. Additional POP Accounts Creation where the user supply only his
+> main
+> username/password (probably provided from a PPP Account already
+> created)
+> and his POP username/password for this specific account.
+(actually need something more general i guess - probably need some way to say
+which accounts (svc_acct) can log in and make changes per customer (cust_main) )
+
+this is awfully vauge, perhaps email for more info? don't want to alientate
+someone with accounting experience, but i just don't have time right now.
+.
+Hi Ivan,
+.
+Thanks for the information. It took me a little while to figure it out, but I
++was
+able to create an invoice. As a lamer and an accountant, may I make a few
+suggestions?
+.
+On the Customer view page:
+1) Layout the information in the manner the invoicing process is conducted.
+ a) Customer information
+ b) Package Ordering
+ c) Add a "Create & Edit Invoice" section - this allows auditing of the
+invoice before it is processed.
+ d) then put the billing section to actually process the invoice
+ e) then put payment history information
+.
+Thanks,
+Mark Roberts <mroberts@iopenenterprises.com>
+
+
+new overdue code might be overzealous. test carefully.
+
+Port Freeside to use the modules that were abstracted from it:
+Net::SSH, Net::SCP, DBIx::DataSource and DBIx::DBSchema, at least.
+
+"first package" and email invoice (?) not sticky on errors in new/edit customer
+screen.
+
+http://www.ipmeter.com/ integration would be useful
+
+http://tangram.sourceforge.net/
+Tie::DBI
+
+mmm, http://pootpoot.com/~dlowe/DBIx-Table/
+
+The cybercash links in htdocs/docs/config.html are b0rken.
+
+Yes. Which is what I've been trying to tell you. (destination user,
+destination domainname) would be represented by the svcnum of a record in
+svc_acct. (In retrospect, using the uid instead of the svcnum was a bad
+choice). (domuser, domain name) would be part of the svc_acct_sm record,
+as domuser and domsvc.
+.
+Upon further consideration, I'll probably eliminate the svc_acct_sm table
+completely, and just add a field for the svcnum of a domain and the svcnum
+of a destination mailbox to svc_acct (or perhaps a one-to-many
+relationship - multiple svcnum(s) for multiple destination mailboxes.
+hmm.)
+
+> > > > Longer-term, I need to do something about the length of the
+> > > > column names -
+> > > > The SQL1992 standard defines 18 character column names,
+> > > > which would be a
+> > > > reasonable goal.
+> > >
+> > > Maybe the thing to do would be to separate these out to separate
+> > > tables.
+> > > then we could simply use something like id, attrib_name,
+> > attrib_value
+> > > to
+> > > store all of the radius values.
+> >
+> > Hmm, no, that's not quite right. You don't want to store the actual
+> > strings in the records for each account. Probably need a table that
+> > corresponds to the RADIUS dictionary file, with a list of
+> > attributes and
+> > attribute id's, then reference the attribute by id and not name.
+> >
+> > The more difficult bit is handling the service definitions
+> > correctly -
+> > part_svc and it's effects.
+>
+> Yes that could be a bit tricky. Perhaps just one "radius" field in
+> part_svc that held a list of id's from the radius table that applied
+> that particular service?
+.
+No, that wouldn't let you set defaults or fixed values for each attribute,
+like part_svc currently does.
+
+
+
+hmm - if you delete an account in svc_acct somehow that a mail alias points to,
+svc_acct_sm.export will fail. make sure this can't be done using
+the web interface.
+
+Bug: during the linking process apparantly you can link too many services to
+a package. *sigh*
+
+zip code i18n is not very good :( but at least US, CA, HU, ?
+
+ut_phonen doesn't check data length. several
+orthogonal cleanup projects here. *sigh*
+
+update the cybercash links in config.html and in the homepage. add more explicit support for other payment types. etc.
+
+From "Tim Jung" <tjung@igateway.net>
+.
+Automatic CC Decline Notices via email
+Block Time billing for prepaid internet cards (400 hours or whatever block
+time of hours)
+Trouble Ticket System with simple search function for Knowledge Base feature
+Employee Timecards
+Credit Card System support for Red Hat's CCVS, and other Linux credit card
+programs
+Contact Manager/Lead Tracking
+Pre-Sale Quotes
+Cisco NetFlow Account for IP traffic billing
+VoIP and FoIP billing
+Roaming per minute billing based on Radius Proxy support or number they
+dialed into from Radius logs (800# etc)
+Support for OpenSRS Domain Registration
+Support for TUCOWS signup CDs
+
+
+dbdef-create for postgres
+
+pro-rating, fiddling dates
+
+It looks like svc_acct.import doesn't deal well with comments and
+multi-attribute lines.
+
+ivan@rootwood:~/freeside_current$ rgrep -r domuid * | cut -d: -f1 | sort |
+uniq
+CVS/Base/TODO
+TODO
+bin/fs-setup
+bin/svc_acct_sm.export
+bin/svc_acct_sm.import
+htdocs/docs/man/svc_acct_sm.txt
+htdocs/docs/schema.html
+htdocs/edit/CVS/Base/part_svc.cgi
+htdocs/edit/part_svc.cgi
+htdocs/edit/process/svc_acct_sm.cgi
+htdocs/edit/svc_acct_sm.cgi
+htdocs/search/svc_acct_sm.cgi
+htdocs/view/svc_acct_sm.cgi
+site_perl/svc_acct_sm.pm
+
+rootwood:COMPLETEHOST/TODO
+
+Currently, you set a value in the %FS::UID::callback hash with a coderef
+of the code you want to execute, but this was bad design and will shortly
+be changed to a subroutine to which you pass your coderef to register it.
+
+This is not a bug, it is how the system is currently designed. After
+defining a new package, you need to specifically allow agent types to
+purchase packages. You can do this from the edit screen of the new agent
+type.
+.
+It wouldn't be a bad idea to add a configuration value that makes new
+packages available for all currently existing agent types automatically.
+.
+On Fri, Apr 07, 2000 at 10:50:35AM -0500, David Morton wrote:
+> For some reason, the type_pkgs table didn't get updated when I tried to
+> create a domain service and package... insert into type_pkgs values
+> (4,1); fixed it up so that I could actually order the package.
+
+
+From: Chuck Cochems <zaphod@tdl.com>
+.
+1) automated generating of late notices. So far the only way I know to
+generate one is to re-invoice manually.
+.
+2) smart credit card rejection handling. It should e-mail a note at
+least, explainig that it did't go through, and why.
+.
+3)coment field in the main customer record.
+.
+4) streamlined payment entry feature. the current scheme has it fairly
+buried.
+.
+5) queries to show al customers who owe money,and such stuff as that.
+
+
+credits aren't counted against past invoices? hmm. something needs to be
+done to "apply payment" genericly. and zero out invoices etc.
+
+more email which should make it into a more organized TODO list:
+.
+I would also love to see Freeside support bandwidth billing by reading the
+Cisco NetFlow Accounting data so we and other ISP's could automatically bill
+co-located servers and even potentially other virtually hosted sites like
+MUD, Palace Chat, IRC Chat, etc based on the bandwidth they use or average
+sustained rates or whatever. I'm not much of a programmer so I don't know
+what all this entails but I did download a NetFlow client agent/whatever for
+Linux though.
+ .
+It would also be nice to see Freeside be able to read Apache log files and
+bill customers for web traffic that way as an option also. Plus an option to
+bill for excessive disk usage without having to use quotas if you didn't
+want to, would be a nice feature as well. So you could monitor with a script
+or something to see how much disk space a user was using then get some
+average and charge a certain amount for anything above some preset limit for
+that account type. I might be able to hack something like this up, but I'm
+not 100% sure where to start or if there is something out there that could
+be modified or not.
+.
+Do you think that you will ever support the HKS CCVS (Hell's Kitchen
+Software Credit Card Verification Software) since Red Hat bought them out
+and is going to be including that for credit card processing when you buy
+the professional version? What about possibly supporting the OpenCCVS which
+is a GNU/GPL version of a credit card program? I haven't had time to comb
+through the Freeside code to see how hard it would be to add support for
+these as externally called programs.
+.
+Also any thoughts on help desk, and knowledge base stuff? Any thoughts on
+this stuff, and how possible and what kinds of work or time frame would be
+involved?
+.
+Tim Jung
+System Admin
+Internet Gateway Inc.
+tjung@igateway.net
+
+
+
+ CVS via SSH (Score:1)
+ by platinum (jedgar at fxp dot org) on Thursday September 30, @07:13PM EDT (#4)
+ (User Info) http://www.fxp.org/~jedgar
+ The links above are your best bet for basic cvs server configuration. Once you have a pserver set up, you
+ may consider using cvs via ssh. All you need to do is the following:
+
+ 1) Have ssh and sshd set up on the client and server machines
+ 2) Set CVSROOT="joe@example.com:/home/ncvs"
+ 3) Set CVS_RSH="/usr/local/bin/ssh"
+ 4) Use cvs normally
+ (Obviously, insert the proper host/paths above)
+
+ You can also set up cvs/ssh to not need a password every time (similiar to an initial 'cvs login'):
+
+ 1) run ssh-keygen on client machine using no passphrase.
+ 2) copy/add ~/.ssh/identity.pub on the client to ~/.ssh/authorized_keys on the server
+ (man ssh for more details)
+
+ The main reason I mentio
+ CVS via SSH (Score:1)
+ by platinum (jedgar at fxp dot org) on Thursday September 30, @07:13PM EDT (#4)
+ (User Info) http://www.fxp.org/~jedgar
+
+
+There's no way to do this currently, though it would be pretty
+straightforward to modify the source - specifically, the _collect_
+subroutine in FS::cust_main.
+>
+On Mon, Dec 13, 1999 at 04:05:32PM -0700, Jeff Garner wrote:
+> Freeside will e-mail my users when they are billed if they are setup as
+> billing.
+>
+> When setup by credit card it does not e-mail them. Is there a way to
+> turn on e-mail invoices for those who are billed via credit card? Kind
+> of like a recipt of billing....
+
+
+doc: http://www.softagency.co.jp/mysql/qmail.en.html
+
+sql1992.txt standard is 18 character column names. shoot for that, not just
+32 (postgresql default)
+
+Also note that (AFAIK) Freeside won't display any package that has more
+than one service on the "Add Customer" page. The reason for this is
+because there's no way to dynamically alter the displayed html form
+based on which package is selected. One possible solution would be to
+make an additional page that's used in the signup process that would
+display the form for each package, like a MS-style "Wizard". The first
+page lets you select the package, then the second page has the custom
+form with fields for each service in that package and a save button. Of
+course, that would require a little perl work.
+.
+Later,
+Scott Cruzen <sic@boernenet.com>
+
+
+Your suggested script with back up /usr/local/etc/freeside, but will miss
+any database not named `freeside'. Both of our scripts are specific to
+MySQL. If you're interested in contributing to Freeside, maybe you could
+work on a script which: reads the mapsecrets configuration file and then
+each secrets file to find out what specific database engine(s) (MySQL,
+PostgreSQL, etc.) and database(s) need to be backed up, then does so,
+serializing backups of the same engine, i.e. stop mysql, do all the mysql
+backups, start mysql, stop postgresql, do all the postgresql backups,
+start postgresql, etc.
+> #!/bin/sh
+> apachectl stop
+> mysqldump -t freeside > fs-backup.sql
+> apachectl start
+> tar -Pzcvf fs-backup-`date +%y%m%d%H%M%S`.tgz fs-backup.sql /usr/local/etc/freeside/
+> rm fs-backup.sql
+
+I chose to use counters in the filesystem because there is no standard way
+to get the value of an auto-incrementing keyfield which is common across
+all databases (as seen through DBI/DBD).
+.
+It certainly wouldn't be a bad idea to use the database-specific methods,
+when available.
+
+htdocs/edit/svc_acct.cgi:
+(Does the `*HIDDEN*' show up when you are adding a new account, and
+specify the password, then receive an error and are returned to the form?)
+
+more DOC:
+Thought some of you might be interested in this:
+
+<ftp://ftp.minivend.com/pub> has CyberCash compatibility modules for
+Paymentnet <http://www.paymentnet.com> and Authorizenet
+<http://www.authorizenet.com> which should allow you process transactions
+using those services as well as CyberCash.
+
+The files are named CCLib.pm.paymentnet and CCLib.pm_authorizenet,
+respectively, and are installed by renaming to CCLib.pm and moving to your
+site_perl directory. Otherwise, follow the directions for Cybercash v2 in
+htdocs/docs/config.html
+
+DOC:
+fs_passwd/ is a client-server replacement for the `passwd', `chfn' and
+`chsh' commands that updates the Freeside database. (so for that to be
+useful, you'd have to be exporting that data periodically)
+
+fs_radlog/ is a client-server RADIUS log parser that stuffs the data into
+SQL. It isn't finished, and probably won't be unless someone who I can't
+convince to use one of the RADIUS daemons that logs to SQL directly pays
+me money or something.
+
+fs_signup/ is a client-server signup server. i'm just finishing it up
+now; probably isn't on your machine yet.
+
+
+http://www.sisd.com/freeside/list-archive/msg00812.html
+
+package definitions should be implicit allow wrt agent types, not implicit deny
+(with the old behavior possible via a config file)
+
+> So is there anyway it could be setup to allow you to select a "primary
+> service" from each package? This service would be the one you were prompted
+> for. Could the signup server then be expanded to allow users to go into
+> their package and "turn-on" the remaining non-primary services(using the
+> primary account.)
+
+take the GPL'ed whois proxy stuff at www.geektools.com and turn it into
+intelligence for Net::Whois.
+
+A web version of the fs_passwd stuff would be nifty.
+
+If you have Cistron authenticating directly from MySQL, you can replicate
+in real-time instead of exporting periodically. See
+<http://www.mysql.com/Manual_chapter/manual_Common_problems.html#Replication>.
+
+these go in docs:
+<http://www.sisd.com/freeside/list-archive/msg00541.html> (was 546), and
+
+and http://www.sisd.com/freeside/list-archive/msg00421.html (was 423)
+
+> > 5: Is there anyway to get freeside to send a sysadmin a warning when a
+> > credit card has expired?
+No, but there should be.
+
+Put this in the doc (quoting Mark Wells <mark@pc-intouch.com>):
+>Of course, thanks to the sheer coolness of SQL and MyODBC, you can do
+>whatever reports you want in basically whatever application you want.
+>There's no need for Freeside itself to do any reports at all.
+
+middle names and titles
+
+On Wed, Jul 07, 1999 at 01:11:40PM -0400, Frank Nazario wrote:
+> Playing and entering information to Freeside i encountered the following
+> missing reports:
+>
+> View Customers by Agent
+>
+> View Pending Invoices
+>
+
+grep 'uncomment this to encrypt password immediately' site_perl/svc_acct.pm
+Not to say that it shouldn't be a configurable option.
+
+in site_perl/cust_main_invoice.pm (elsewhere?), error out if mydomain config file is gone
+(at least until the idea of a default domain goes away)
+
+FS::Record::qsearch does an eval every loop iteration (which is itself not
+guaranteed to work across all DBD's and should be fixed). This has got to be
+slow. Fix it. (I think recent Perls might have a way to accept a variable
+there, no eval needed?)
+
+Could you have added /bin/sync, /sbin/shutdown, and /bin/halt to the
+`shells' configuration file before importing, and removed them afterwords?
+(even better if svc_acct.import did that automatically - it could just
+munge and restore @FS::svc_acct::shells... hmm.)
+
+> BTW, Ivan, I am trying to verify in an additional database table that a
+> particular user doesn't exist. This database is used to store email aliases a$
+> additional POP boxes for our customers (kinda like AOL allows). I have toyed
+> with the idea of just writing the aliases to an email only svc_acct that
+> doesn't write to the password file, but that isn't really how I want to do it.
+
+Actually, I think that's a pretty good way to do it. Cerkit contributed
+support a little while back for svc_acct.pm and svc_acct.export for
+multiple export targets. It needs to be cleaned up and documented, which
+I'll try to get to soon. For this to work correctly, the svc_acct_sm
+table should go away, along with the concept of a "default" domain.
+
+default setting for new packages should allow all agents to purchase them...
+with a config file for the old behaviour
+
+fix or replace Term::Query (Quiz::Question doesn't do what i need)
+
+Check config file reading stuff from CPAN
+
+Authorizenet module from CPAN!
+
+<http://www.math.fu-berlin.de/~leitner/mutt/faq.html> has a good y2k complience
+statement!
+
+ I'm hoping Freeside can support arbitrailly complex pricing plans
+ because of a simple concept: all prices are perl expressions. So if
+ you use `19.95' for example, perl evalates that to be `19.95'. But if
+ you need to do a complex pricing scheme, you just need to write an
+ appropriate perl expression, which will most likely pull data from the
+ database to return pricing. Some things will already log to SQL; for
+ example most RADIUS servers can or have a patch available. Getting
+ Freeside to bill based on any sort of data then becomes a matter of
+ importing the data into the database.
+
+ There are some issues involved with pro-rating, partial month charges,
+ that sort of thing. Expressions will need a standard way to have the
+ applicable time/data ranges passed to them. Also the expressions are
+ currently running under the Safe perl module, and the opmask might not
+ be right in all situations. I'll try to spend some time working on
+ this if you are using it.
+
+> 2. can customers view their bills on-line.
+
+Not yet; it needs to be proxied from Freeside to a customer web server in
+a secure way using something not completely unlike the fs_passwd,
+fs_passwdd, fs_passwd_server trio.
+
+
+> Lastly, if someone over pays on an invoice, the credit part does not flow
+> over to other invoices..
+
+The total balance flows over correctly, but individual payments don't.
+The code you're looking for is in FS::cust_pay::insert
+
+The question of what to do with overpayments that don't have another
+invoice to flow into (yet.. or possibly not) is still an open one. The
+legacy system Freeside replaced long ago had a separate place for this
+(payments waiting for an invoice) for each customer, and it gave our
+bookeeper fits.
+
+
+option to relax username uniqueness in favor of username+domain or mail/shell
+vs. radius to ease import for isp's with namespace problems or who buy others.
+
+do i have to store anything for radius realms besides regular radius attributes
+(which are handled fine now)?
+
+warn or complain or something when invoice_from is empty (and we use it)
+
+Right now Freeside uses the `freq' field of a package definition as a
+number of months. The specific section of code you're looking for is in
+FS::cust_main::bill:
+
+ #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;
+
+..and when I went poking for this, looks like it tells us just what needs
+to be done! Hehehe...
+
+Date::Manip can handle cool things like "+ 1 month" (actually the current
+case of /^(\d+)$/ would have to be added as a special case of "+ $1
+month") and "+ 30 days" (what you need) and even "+ 5 business days" !
+
+
+On Wed, Apr 28, 1999 at 08:38:16PM +0000, Kristian Hoffmann wrote:
+> I can't quite seem to figure out how this exporting works. From what I
+> understand, when you run svc_acct.export, it rewrites the /etc/passwd,
+> /etc/shadow, etc. files. Is this only for initial setups with the
+> export hooks being in the pm's?
+
+You can use both, or just one method. The configuration files control
+this. One of the things in the TODO is to take out the last few things
+that aren't customizable wrt this and put them in config files.
+
+http://www.daemonnews.org/199905/user-mgmt.html
+
+Term::Query doesn't install out of the box from CPAN. Fix it (and get it
+submitted upstream!), or remove requirement from bin/svc_acct.import and
+bin/svc_acct_sm.import and take it out of the install instructions.
+
+use this cool link to explain the Freeside API
+ftp://cpan.nas.nasa.gov/pub/perl/CPAN/doc/FMTEYEWTK/easy_objects.html
+
+Multiple tax rates by geographic region (county, state, and county) are
+supported; just choose View/Edit tax rates from the main menu.
+
+Multiple tax rates by package are not (yet) supported.
+
+On Wed, Jul 07, 1999 at 12:13:36PM -0400, Shaun Batterton wrote:
+> How would you handle something like multiple tax rates and multiple
+> states? For example in Connecticut, they just changed computer and/or
+> data processing services to 3% (whatever that is), and everything else
+> is 6%.
+
+
+> Second, when trying to add a new user I get two types of errors; first one
+> is when I place an e-mail address and select the "submit," Freeside
+> complains with "Error: Unknown local account (specified literally)"
+.
+You probably put a (local) email address in for email invoices. Freeside
+stores these as references to the database records, so (for example) they
+follow username changes.
+.
+I'm guessing you put in the email address that you were creating, and got
+that error because it didn't exist yet. Sounds like a buglet to me. I'll
+try to fix that soon; in the meantime you can add the invoicing email
+address afterwords.
+
+(workaround for postgres before 6.5) (unlikely to ever be implemented)
+In the mean-time, this could probably be fixed with the reverse of
+the kludge in FS::Record::new. This removes `$' and `,' from money fields
+coming out of the database. Something which fixed up the data so Postgres
+was happy with it could go in FS::Record::_quote, for data going into the
+database.
+
+our data display problem might be a Freeside problem wrt not using
+Oracle-compatible DBI syntax (fixed using the return value from $sth->execute
+as a number of rows - something else?).
+
+hooks for arbitrary commands out of configuration files
+svc_acct.pm svc_acct_sm.pm etc.
+
+Add this to a FAQ, along with doing it for middle names:
+
+
+> What I'm finding difficult is how to easily
+> customize fields. For example, I am trying to add a "middle name" field
+> to the Customer Edit, view, etc. If I'm going about it right, it appears
+> I have to edit the cust_main.cgi under edit and edit/process and the
+> site_perl/cust_main.pm, as well as other things. Perhaps you could shed
+> some light on the best way of doing this.
+
+You have the basic idea. To implement that completely, I would:
+- Add the new field to bin/fs-setup for new users
+- Document the field in htdocs/docs/schema.html
+- Document the change in a new file, htdocs/docs/upgrade4.html
+* Run bin/dbdef-create
+* Add the new field to edit/cust_main.cgi and edit/process/cust_main.cgi
+
+For bonus points, I'd grep around for the various bits which use "$first
+$last" or "$last, $first" and replace them with a method call in cust_main.pm,
+ , like search/cust_main.cgi
+
+document security model:
+Don't forget about Apache usernames - since, via the mapsecrets file, each
+user can login to the SQL database with a different username and
+password, you can utitilize the security model of the SQL database as
+well. Also, each username here can point to a different configuration
+directory where you could store user-specific configuration info. Then
+you could link each username to one-to-many agents.
+(The web demo works using a trivial version of this.)
+
+Yes, queue processing or the equivalent via checkpoint fields on various
+talbes (which you pick up via a pretty simple SELECT) would be really
+nice too.
+
+default (and ordering) state/county/country config file
+expand the
+cust_main_county table to provide a preferred ordering, so the most common
+entries would be at the top of the selection box. automatically, based on
+recent selections?
+
+hmm... maybe svc_acct__shell should check off the legal shells list if
+applicable? yeah... cool.
+
+payinfo field should me much larger than 16
+
+
+[Mon Apr 12 20:31:21 1999] [error] [Mon Apr 12 20:31:21 1999] null: Error closing true: Broken pipe at /usr/local/lib/site_perl/FS/cust_main.pm line 615.
+
+javascript (yuck!) "are you sure?" confirmation on cancelations, etc.
+(view/cust_pkg and view/svc_*)
+
+get rid of time2str("%D") which formats dates in a non-y2k-safe looking fashion
+(all the actual date handling uses UNIX timestamps and is fine)
+
+uncomment expire in view/cust_pkg.cgi and find the expire cron from fsold
+
+(Test this)
+one-time/per-customer/? changes in rates and descriptions ('remembered
+invoices'): implement by creating a new package on the fly... but it isn't
+associated with any agent types so it won't show up for other customers to buy.
+(but also... make sure they go away when the customer does! - need this? :
+ one-off package edits! : need a cust_pkgs or cust_part_pkgs or something table,
+ with custnum and partpkg (like type_pkgs)
+(what happens if you hit "custom pricing" but the pricing is already custom?)
+
+Lay out any remaining ugly forms better.
+
+remove "records identical" warning? gets in the way of more important stuff.
+or fix logic which tries to update identical records??
+1.2 should be quiet enough that the error log is useful, hopefully.
+
+Postgres has a maximum column length of 31 characters (but see NAMEDATALEN in
+postgres_ext.h). part_svc has columns like: svc_acct__radius_Attribute_flag
+(22 characters!) It seems that stuff over the limit is silently ignored,
+so we get 4 characters back. So, Radius_Attributes are max 13 characters with
+stock Postgres. see rfc2138 for what's affected
+What's a good fix? (besides recompiling postgres with NAMEDATALEN 64)
+(mysql has a 64 character max column length. others?)
+
+[Mon Mar 29 06:57:56 1999] -e: Use of uninitialized value at /usr/lib/perl5/Date/Format.pm line 333.
+(when sending mail in cust_main.pm::bill or svc_domain.pm)
+
+look at DBIx::Recordset! (and Tie::DBI, and...)
+
+undefined conf/lpr gives this uninfomative error:
+[Fri Feb 26 16:42:36 1999] bill.cgi: Can't do bidirectional pipe at
+/usr/lib/per
+l5/site_perl/FS/cust_main.pm line 629.
+[Fri Feb 26 16:42:38 1999] bill.cgi: Error closing : Broken pipe at
+/usr/lib/per
+l5/site_perl/FS/cust_main.pm line 631.
+So give a meaningful error!
+
+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
+
+i10n: Apache::Language
+
+Apache::Session? Other useful Apache::* ?
+
+email invoices are only sent for the BILL payby. If setup, should statements
+(since they're not invoices) be sent for COMP and CARD as well?
+
+$cgi->keywords is causing the (hard to trace) error:
+ Use of uninitialized value at (eval 5) line 5
+
+edit/cust_main.cgi gives an uninformative error message:
+> Can't call method "agentnum" without a package or object reference at
+> /usr/local/apache-ssl/htdocs/freeside/edit/cust_main.cgi line 116.
+if there are no agents.
+
+(is this missing on any web screens? (easy with $cust_svc->label)
+Add the ability for services to filter information up to the package level
+for web screens, so you can select a particlar package based
+on username or domain name, etc.
+
+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.
+
+false laziness: edit/cust_main.cgi got some parts copied from edit/svc_acct.cgi
+the web interface in general needs to be redone in a more abstract way.
+
+false laziness: some of search/svc_acct_sm.cgi was copied to search/svc_domain.cgi. but web interface in general needs to be rewritten in a mucho cleaner way.
+
+subroutine the where clause (eventually all SQL) as OO perhaps (has anyone done this?)
+
+add a select method to FS::Record?
+
+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.
+(but also... make sure they go away when the customer does! - need this? :
+ one-off package edits! : need a cust_pkgs or cust_part_pkgs or something table,
+ with custnum and partpkg (like type_pkgs)
+(what happens if you hit "custom pricing" but the pricing is already custom?)
+
+You can't delete the stuff under administration yet. Add this,
+_including_ making sure the thing you are deleting is not in use!
+
+add links on view/cust_main.cgi to setup services, like view/cust_pkg.cgi
+
+FS::cust_pkg _require_'s FS::$svc, but this won't work with %FS::UID::callback
+loading of configuration. (pry need same idea, but will run immediately if
+context allows). Looks like error is masked by 'use FS::cust_svc' which in
+turn 'use's FS::{svc_acct, svc_acct_sm, svc_domain}' which is now explicit
+w/comments in source
+
+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.
+
+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)
+
+remove whois_hack set to 1 for svc_domain.pm? add all known registries and
+whois accordingly.
+.us domains and others!
+site_perl/svc_domain.cgi (hmm... or maybe should have a button? or maybe svc_domain.pm should handle this) should set $whois_hack for non-internic domains, so you can add them...
+
+turn on the depriciation warnings for [e]idiot in FS::CGI. Stop using [e]idiot
+the last places it is (htdocs/search/ htdocs/misc/ htdocs/misc/process)
+
+(test cust_main.pm with cybercash v2 and v3, especially with the callback
+ stuff AND with mod_perl w/cybercash v2 kludge in package main)
+(callback stuff should be eliminated by now)
+
+bah, table/itable/*table in FS::CGI is silly.
+
+doc Apache::AuthDBI as well
+..
+Provide sample httpd.conf files.
+
+hey look: Tie::DBI! Check that out. Override its commit with something that
+does perl-side caching for ? a performance improvement and as an emulation
+layer to plug in f.ex mysql's atomic transactions
+..
+Record.pm uses does some non-portable DBI things. MySQL and Pg seem fine.
+Fix it anyway unless we migrate to Tie::DBI.
+
+faq
+
+cust_bill.pm uses '==' comparison on dates because they're currently ints
+
+config file for allowed card types
+
+write instructions for adding new services w/svc_Common.pm. Get rid of all
+places where svc_* tables are hardcoded (rename svc_acct_pop to part_pop so
+we can do that)
+
+test and document libapache-dbi-logger (woo!)
+
+radius logfile parsing and perl expression check.
+
+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).
+
+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).
+
+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) - I could have sworn I saw Text::Soundex on CPAN?!
+
+should be able to link on some field in email alias (right now you can link
+on username or domain with a fallback to svcnum)
+
+generalize and make configurable new invoice printing scheme in FS::cust_main::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.
+
+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)
+
+in UI, s/State/State\/Provence/go and s/County/County\/Locality/go
+
+what else (besides l10n) for i18n? (money!)
+
+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. Maybe Embperl or something along those lines. ?
+
+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 file access from regular open(FILE,) stuff to OO, because of
+problems scoping and passing filehandles like that.
+
+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?
+
+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.
+
+you should be able to fiddle the setup date in cust_pkg. (at least initially)
+
+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. (no, import desync_hosts
+type stuff from cerkit)
+...
+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)
+
+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.
+
+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!
+
+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.
+
+integrate w/IDEA's signup server
+
+$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.
+
+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.
+
+configuration/setup should get web interface
+...
+/usr/local/etc/freeside should be configurable
+...
+(probably as part of some automated installation process?)
+
+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.
+...
+if i'm really bored, find the /rdb interface in fsold and port it to NoSQL,
+and while I'm add it add interfaces for AnyDBM_File tied hash.. hmm. Shouldn't
+an FS::Record have something to do with a tied hash? But we don't want
+performance to go gaga... maybe something with commit to help out here?
+...
+Ok: FS::Record gives you a tied hash, and you get methods for commit, etc.
+
+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.
+
+
--- /dev/null
+#!/bin/sh
+/etc/init.d/apache stop
+/etc/init.d/mysql stop
+tar czvf var-lib-mysql-`date +%y%m%d%H%M%S`.tar.gz /var/lib/mysql
+/etc/init.d/mysql start
+/etc/init.d/apache start
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: dbdef-create,v 1.3 2001-04-15 12:56:31 ivan Exp $
+#
+# create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command
+# not in Pg) based on fs-setup
+#
+# ivan@sisd.com 98-jun-2
+#
+# $Log: dbdef-create,v $
+# Revision 1.3 2001-04-15 12:56:31 ivan
+# s/dbdef/DBIx::DBSchema/
+#
+# Revision 1.2 1998/11/19 11:17:44 ivan
+# adminsuidsetup requires argument
+#
+
+use strict;
+use DBI;
+use DBIx::DBSchema;
+use FS::UID qw(adminsuidsetup datasrc driver_name);
+
+my $user = shift or die &usage;
+
+my($dbh)=adminsuidsetup $user;
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+my $dbdef = new_native DBIx::DBSchema $dbh;
+
+#important
+$dbdef->save($dbdef_file);
+
+sub usage {
+ die "Usage:\n dbdef-create user\n";
+}
--- /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;
+
--- /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);
+die "Not running uid freeside!" unless checkeuid();
+
+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 { s/\-/_/g; $_; } split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+ foreach my $statement (
+ "ALTER TABLE svc_acct ADD rc_$attribute varchar($char_d) NULL",
+ "ALTER TABLE part_svc ADD svc_acct__rc_$attribute varchar($char_d) NULL;",
+ "ALTER TABLE part_svc ADD svc_acct__rc_${attribute}_flag char(1) NULL;",
+ ) {
+ $dbh->do( $statement ) or warn "Error executing $statement: ". $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 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);
+die "Not running uid freeside!" unless checkeuid();
+
+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 { s/\-/_/g; $_; } split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+ foreach my $statement (
+ "ALTER TABLE svc_acct ADD radius_$attribute varchar($char_d) NULL",
+ "ALTER TABLE part_svc ADD svc_acct__radius_$attribute varchar($char_d) NULL;",
+ "ALTER TABLE part_svc ADD svc_acct__radius_${attribute}_flag char(1) NULL;",
+ ) {
+ $dbh->do( $statement ) or warn "Error executing $statement: ". $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 user\n";
+}
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: fs-setup,v 1.37 2001-06-03 14:16:11 ivan Exp $
+#
+# 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
+#
+# $Log: fs-setup,v $
+# Revision 1.37 2001-06-03 14:16:11 ivan
+# allow empty refund reasons
+#
+# Revision 1.36 2001/04/15 12:56:31 ivan
+# s/dbdef/DBIx::DBSchema/
+#
+# Revision 1.35 2001/04/15 09:36:43 ivan
+# http://www.sisd.com/freeside/list-archive/msg01450.html
+#
+# Revision 1.34 2001/04/09 23:05:16 ivan
+# Transactions Part I!!!
+#
+# Revision 1.33 2001/02/03 14:03:50 ivan
+# time-based prepaid cards, session monitor. woop!
+#
+# Revision 1.32 2000/12/04 00:13:02 ivan
+# fix nas.last type
+#
+# Revision 1.31 2000/12/01 18:34:53 ivan
+# another tyop
+#
+# Revision 1.30 2000/12/01 18:33:32 ivan
+# tyop
+#
+# Revision 1.29 2000/11/07 15:00:37 ivan
+# session monitor
+#
+# Revision 1.28 2000/10/30 10:47:26 ivan
+# nas.last can't be defined NULL if indexed
+#
+# Revision 1.26 2000/07/06 08:57:27 ivan
+# support for radius check attributes (except importing). poorly documented.
+#
+# Revision 1.25 2000/06/29 12:00:49 ivan
+# support for pre-encrypted md5 passwords.
+#
+# Revision 1.24 2000/03/02 07:44:07 ivan
+# typo forgot closing '
+#
+# Revision 1.23 2000/02/03 05:16:52 ivan
+# beginning of DNS and Apache support
+#
+# Revision 1.22 2000/01/31 05:22:23 ivan
+# prepaid "internet cards"
+#
+# Revision 1.21 2000/01/30 06:03:26 ivan
+# postgres 6.5 finally supports decimal(10,2)
+#
+# Revision 1.20 2000/01/28 22:53:33 ivan
+# track full phone number
+#
+# Revision 1.19 1999/07/29 08:50:35 ivan
+# wrong type for cust_pay_batch.exp
+#
+# Revision 1.18 1999/04/15 22:46:30 ivan
+# TT isn't a state!
+#
+# Revision 1.17 1999/04/14 07:58:39 ivan
+# export getsecrets from FS::UID instead of calling it explicitly
+#
+# Revision 1.16 1999/02/28 19:44:16 ivan
+# constructors s/create/new/ pointed out by "Bao C. Ha" <bao@hacom.net>
+#
+# Revision 1.15 1999/02/27 21:06:21 ivan
+# cust_main.paydate should be varchar(10), not @date_type ; problem reported
+# by Ben Leibig <leibig@colorado.edu>
+#
+# Revision 1.14 1999/02/07 09:59:14 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.13 1999/02/04 06:09:23 ivan
+# add AU provences
+#
+# Revision 1.12 1999/02/03 10:42:27 ivan
+# *** empty log message ***
+#
+# Revision 1.11 1999/01/17 03:11:52 ivan
+# remove preliminary completehost changes
+#
+# Revision 1.10 1998/12/16 06:05:38 ivan
+# add table cust_main_invoice
+#
+# Revision 1.9 1998/12/15 04:36:29 ivan
+# s/croak/die/; #oops
+#
+# Revision 1.8 1998/12/15 04:33:27 ivan
+# dies if it isn't running as the freeside user
+#
+# Revision 1.7 1998/11/18 09:01:31 ivan
+# i18n! i18n!
+#
+# Revision 1.6 1998/11/15 13:18:02 ivan
+# remove debugging
+#
+# Revision 1.5 1998/11/15 09:43:03 ivan
+# update for new config file syntax, new adminsuidsetup
+#
+# Revision 1.4 1998/10/22 15:51:23 ivan
+# also varchar with no length specified - postgresql fix broke mysql.
+#
+# Revision 1.3 1998/10/22 15:46:28 ivan
+# now smallint is illegal, so remove that too.
+#
+
+#to delay loading dbdef until we're ready
+BEGIN { $FS::Record::setup_hack = 1; }
+
+use strict;
+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::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
+use FS::Record;
+use FS::cust_main_county;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+###
+
+print "\nEnter the maximum username length: ";
+my($username_len)=&getvalue;
+
+print "\n\n", <<END, ":";
+Freeside tracks the RADIUS attributes User-Name, check attribute Password and
+reply attribute Framed-IP-Address for each user. You can specify additional
+check and reply attributes. First enter any additional RADIUS check attributes
+you need to track for each user, separated by whitespace.
+END
+my @check_attributes = map { s/\-/_/g; $_; } 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 { s/\-/_/g; $_; } split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+#my(@date_type) = ( 'timestamp', '', '' );
+my(@date_type) = ( 'int', 'NULL', '' );
+my(@perl_type) = ( 'varchar', 'NULL', 255 );
+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 DBIx::DBSchema ( map {
+ my(@columns);
+ while (@{$tables{$_}{'columns'}}) {
+ my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4;
+ push @columns, new DBIx::DBSchema::Column ( $name,$type,$null,$length );
+ }
+ DBIx::DBSchema::Table->new(
+ $_,
+ $tables{$_}{'primary_key'},
+ DBIx::DBSchema::ColGroup::Unique->new($tables{$_}{'unique'}),
+ DBIx::DBSchema::ColGroup::Index->new($tables{$_}{'index'}),
+ @columns,
+ );
+} (keys %tables) );
+
+#add radius attributes to svc_acct
+
+my($svc_acct)=$dbdef->table('svc_acct');
+
+my($attribute);
+foreach $attribute (@attributes) {
+ $svc_acct->addcolumn ( new DBIx::DBSchema::Column (
+ 'radius_'. $attribute,
+ 'varchar',
+ 'NULL',
+ $char_d,
+ ));
+}
+
+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_acct_sm svc_domain 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,
+ ));
+ }
+}
+
+#important
+$dbdef->save($dbdef_file);
+&FS::Record::reload_dbdef($dbdef_file);
+
+###
+# create 'em
+###
+
+my($dbh)=adminsuidsetup $user;
+
+#create tables
+$|=1;
+
+my @sql = $dbdef->sql($dbh);
+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 UT VT VI VA WA WV WI WY AE AA AP
+) ) {
+ 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;
+}
+
+$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.
+###
+sub tables_hash_hack {
+
+ #note that s/(date|change)/_$1/; to avoid keyword conflict.
+ #put a kludge in FS::Record to catch this or? (pry need some date-handling
+ #stuff anyway also)
+
+ my(%tables)=( #yech.}
+
+ 'agent' => {
+ 'columns' => [
+ 'agentnum', 'int', '', '',
+ 'agent', 'varchar', '', $char_d,
+ 'typenum', 'int', '', '',
+ 'freq', 'int', 'NULL', '',
+ 'prog', @perl_type,
+ ],
+ 'primary_key' => 'agentnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['typenum'] ],
+ },
+
+ 'agent_type' => {
+ 'columns' => [
+ 'typenum', 'int', '', '',
+ 'atype', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'typenum',
+ 'unique' => [ [] ],
+ 'index' => [ [] ],
+ },
+
+ 'type_pkgs' => {
+ 'columns' => [
+ 'typenum', 'int', '', '',
+ 'pkgpart', 'int', '', '',
+ ],
+ 'primary_key' => '',
+ 'unique' => [ ['typenum', 'pkgpart'] ],
+ 'index' => [ ['typenum'] ],
+ },
+
+ 'cust_bill' => {
+ 'columns' => [
+ 'invnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ '_date', @date_type,
+ 'charged', @money_type,
+ 'printed', 'int', '', '',
+ ],
+ 'primary_key' => 'invnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['custnum'] ],
+ },
+
+ 'cust_bill_pkg' => {
+ 'columns' => [
+ 'pkgnum', 'int', '', '',
+ 'invnum', 'int', '', '',
+ 'setup', @money_type,
+ 'recur', @money_type,
+ 'sdate', @date_type,
+ 'edate', @date_type,
+ ],
+ 'primary_key' => '',
+ 'unique' => [ ['pkgnum', 'invnum'] ],
+ 'index' => [ ['invnum'] ],
+ },
+
+ 'cust_credit' => {
+ 'columns' => [
+ 'crednum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ '_date', @date_type,
+ 'amount', @money_type,
+ 'otaker', 'varchar', '', 8,
+ 'reason', 'varchar', 'NULL', 255,
+ ],
+ 'primary_key' => 'crednum',
+ 'unique' => [ [] ],
+ 'index' => [ ['custnum'] ],
+ },
+
+ '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,
+ 'address1', 'varchar', '', $char_d,
+ 'address2', 'varchar', 'NULL', $char_d,
+ 'city', 'varchar', '', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
+ 'zip', 'varchar', '', 10,
+ 'country', 'char', '', 2,
+ 'daytime', 'varchar', 'NULL', 20,
+ 'night', 'varchar', 'NULL', 20,
+ 'fax', 'varchar', 'NULL', 12,
+ 'payby', 'char', '', 4,
+ 'payinfo', 'varchar', 'NULL', 16,
+ #'paydate', @date_type,
+ 'paydate', 'varchar', 'NULL', 10,
+ 'payname', 'varchar', 'NULL', $char_d,
+ 'tax', 'char', 'NULL', 1,
+ 'otaker', 'varchar', '', 8,
+ 'refnum', 'int', '', '',
+ ],
+ 'primary_key' => 'custnum',
+ 'unique' => [ [] ],
+ #'index' => [ ['last'], ['company'] ],
+ 'index' => [ ['last'], ],
+ },
+
+ 'cust_main_invoice' => {
+ 'columns' => [
+ 'destnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'dest', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'destnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['custnum'], ],
+ },
+
+ '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', 'varchar', 'NULL', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'country', 'char', '', 2,
+ 'tax', 'real', '', '', #tax %
+ ],
+ 'primary_key' => 'taxnum',
+ 'unique' => [ [] ],
+ # 'unique' => [ ['taxnum'], ['state', 'county'] ],
+ 'index' => [ [] ],
+ },
+
+ 'cust_pay' => {
+ 'columns' => [
+ 'paynum', 'int', '', '',
+ 'invnum', '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.
+ ],
+ 'primary_key' => 'paynum',
+ 'unique' => [ [] ],
+ 'index' => [ ['invnum'] ],
+ },
+
+ 'cust_pay_batch' => { #what's this used for again? list of customers
+ #in current CARD batch? (necessarily CARD?)
+ 'columns' => [
+ 'invnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'last', 'varchar', '', $char_d,
+ 'first', 'varchar', '', $char_d,
+ 'address1', 'varchar', '', $char_d,
+ 'address2', 'varchar', 'NULL', $char_d,
+ 'city', 'varchar', '', $char_d,
+ 'state', 'varchar', '', $char_d,
+ 'zip', 'varchar', '', 10,
+ 'country', 'char', '', 2,
+ 'trancode', 'int', '', '',
+ 'cardnum', 'varchar', '', 16,
+ #'exp', @date_type,
+ 'exp', 'varchar', '', 11,
+ 'payname', 'varchar', 'NULL', $char_d,
+ 'amount', @money_type,
+ ],
+ 'primary_key' => '',
+ 'unique' => [ [] ],
+ 'index' => [ ['invnum'], ['custnum'] ],
+ },
+
+ 'cust_pkg' => {
+ 'columns' => [
+ 'pkgnum', 'int', '', '',
+ 'custnum', 'int', '', '',
+ 'pkgpart', 'int', '', '',
+ 'otaker', 'varchar', '', 8,
+ 'setup', @date_type,
+ 'bill', @date_type,
+ 'susp', @date_type,
+ 'cancel', @date_type,
+ 'expire', @date_type,
+ ],
+ 'primary_key' => 'pkgnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['custnum'] ],
+ },
+
+ 'cust_refund' => {
+ 'columns' => [
+ 'refundnum', 'int', '', '',
+ 'crednum', 'int', '', '',
+ '_date', @date_type,
+ 'refund', @money_type,
+ 'otaker', 'varchar', '', 8,
+ 'reason', 'varchar', '', $char_d,
+ 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
+ # into payment type table.
+ 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
+ ],
+ 'primary_key' => 'refundnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['crednum'] ],
+ },
+
+ 'cust_svc' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'pkgnum', 'int', 'NULL', '',
+ 'svcpart', 'int', '', '',
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ],
+ },
+
+ 'part_pkg' => {
+ 'columns' => [
+ 'pkgpart', 'int', '', '',
+ 'pkg', 'varchar', '', $char_d,
+ 'comment', 'varchar', '', $char_d,
+ 'setup', @perl_type,
+ 'freq', 'int', '', '', #billing frequency (months)
+ 'recur', @perl_type,
+ ],
+ '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', '', '',
+ 'quantity', 'int', '', '',
+ ],
+ 'primary_key' => '',
+ 'unique' => [ ['pkgpart', 'svcpart'] ],
+ 'index' => [ ['pkgpart'] ],
+ },
+
+ 'part_referral' => {
+ 'columns' => [
+ 'refnum', 'int', '', '',
+ 'referral', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'refnum',
+ 'unique' => [ [] ],
+ 'index' => [ [] ],
+ },
+
+ 'part_svc' => {
+ 'columns' => [
+ 'svcpart', 'int', '', '',
+ 'svc', 'varchar', '', $char_d,
+ 'svcdb', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'svcpart',
+ 'unique' => [ [] ],
+ 'index' => [ [] ],
+ },
+
+ #(this should be renamed to part_pop)
+ 'svc_acct_pop' => {
+ 'columns' => [
+ 'popnum', 'int', '', '',
+ 'city', 'varchar', '', $char_d,
+ 'state', 'varchar', '', $char_d,
+ 'ac', 'char', '', 3,
+ 'exch', 'char', '', 3,
+ 'loc', 'char', 'NULL', 4, #NULL for legacy purposes
+ ],
+ 'primary_key' => 'popnum',
+ 'unique' => [ [] ],
+ 'index' => [ [] ],
+ },
+
+ 'svc_acct' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'username', 'varchar', '', $username_len, #unique (& remove dup code)
+ '_password', 'varchar', '', 50, #13 for encryped pw's plus ' *SUSPENDED* (mp5 passwords can be 34)
+ 'popnum', 'int', '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
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['username'] ],
+ },
+
+ 'svc_acct_sm' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'domsvc', 'int', '', '',
+ 'domuid', 'int', '', '',
+ 'domuser', 'varchar', '', $char_d,
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ [] ],
+ 'index' => [ ['domsvc'], ['domuid'] ],
+ },
+
+ #'svc_charge' => {
+ # 'columns' => [
+ # 'svcnum', 'int', '', '',
+ # 'amount', @money_type,
+ # ],
+ # 'primary_key' => 'svcnum',
+ # 'unique' => [ [] ],
+ # 'index' => [ [] ],
+ #},
+
+ 'svc_domain' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'domain', 'varchar', '', $char_d,
+ ],
+ '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_www' => {
+ 'columns' => [
+ 'svcnum', 'int', '', '',
+ 'recnum', 'int', '', '',
+ 'usersvc', 'int', '', '',
+ ],
+ 'primary_key' => 'svcnum',
+ 'unique' => [ [] ],
+ 'index' => [ [] ],
+ },
+
+ #'svc_wo' => {
+ # 'columns' => [
+ # 'svcnum', 'int', '', '',
+ # 'svcnum', 'int', '', '',
+ # 'svcnum', 'int', '', '',
+ # 'worker', 'varchar', '', $char_d,
+ # '_date', @date_type,
+ # ],
+ # 'primary_key' => 'svcnum',
+ # 'unique' => [ [] ],
+ # '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' ] ],
+ },
+
+ );
+
+ %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
+
+#use Pod::Text;
+#$Pod::Text::termcap=1;
+
+my $site_perl = "./FS";
+#my $catman = "./catman";
+#my $catman = "./htdocs/docs/man";
+my $html = "./htdocs/docs/man";
+
+$|=1;
+
+die "Can't find $site_perl and $catman"
+ unless [ -d $site_perl ] && [ -d $catman ] && [ -d $html ];
+
+foreach my $file (
+ glob("$site_perl/*.pm"),
+ glob("$site_perl/*/*.pm"),
+ glob("$site_perl/*/*/*.pm")
+) {
+ #$file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
+ $file =~ /$site_perl\/(.*)\.pm$/ or die "oops file $file";
+ my $name = $1;
+ 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:. --norecurse --htmlroot=$htmlroot $file >$html/$name.html";
+# system "pod2html $file >$html/$name.html";
+}
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: svc_acct.export,v 1.19 2001-05-08 10:44:17 ivan Exp $
+#
+# Create and export password files: passwd, passwd.adjunct, shadow,
+# acp_passwd, acp_userinfo, acp_dialup, users
+#
+# 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
+#
+# $Log: svc_acct.export,v $
+# Revision 1.19 2001-05-08 10:44:17 ivan
+# fix for OO Net::SCP
+#
+# Revision 1.18 2001/04/22 01:56:15 ivan
+# get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)
+#
+# Revision 1.17 2001/02/21 23:48:19 ivan
+# add icradius_secrets config file to export to a non-Freeside MySQL database for
+# ICRADIUS
+#
+# Revision 1.16 2000/07/06 13:23:29 ivan
+# tyop
+#
+# Revision 1.15 2000/07/06 08:57:28 ivan
+# support for radius check attributes (except importing). poorly documented.
+#
+# Revision 1.14 2000/06/29 15:01:25 ivan
+# another silly typo in svc_acct.export
+#
+# Revision 1.13 2000/06/28 12:37:28 ivan
+# add support for config option textradiusprepend
+#
+# Revision 1.12 2000/06/15 14:07:02 ivan
+# added ICRADIUS radreply table support, courtesy of Kenny Elliott
+#
+# Revision 1.11 2000/03/06 16:00:39 ivan
+# sync up with working versoin
+#
+# Revision 1.2 1998/12/10 07:23:15 ivan
+# use FS::Conf, need user (for datasrc)
+#
+
+use strict;
+use vars qw($conf);
+use Fcntl qw(:flock);
+use IO::Handle;
+use DBI;
+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 fields);
+use FS::svc_acct;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$conf = new FS::Conf;
+
+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 $icradiusmachines = $conf->exists('icradiusmachines');
+my @icradiusmachines = $conf->config('icradiusmachines') if $icradiusmachines;
+my $icradius_mysqldest =
+ $conf->config('icradius_mysqldest') || "/usr/local/var/"
+ if $icradiusmachines;
+my $icradius_mysqlsource =
+ $conf->config('icradius_mysqlsource') || "/usr/local/var/freeside"
+ if $icradiusmachines;
+my $icradius_dbh;
+if ( $icradiusmachines && $conf->exists('icradius_secrets') ) {
+ $icradius_dbh = DBI->connect($conf->config('icradius_secrets'))
+ or die $DBI::errstr;;
+} else {
+ $icradius_dbh = dbh;
+}
+
+my $textradiusprepend = $conf->config('textradiusprepend');
+
+my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+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);
+unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
+ seek(EXPORT,0,0);
+ my($pid)=<EXPORT>;
+ chop($pid);
+ #no reason to start loct 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',{});
+
+( open(MASTER,">$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)
+) or die "Can't open $spooldir/shadow: $!";
+( 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)
+) or die "Can't open $spooldir/acp_dialup: $!";
+( open (USERS,">$spooldir/users")
+ and flock(USERS,LOCK_EX|LOCK_NB)
+) or die "Can't open $spooldir/users: $!";
+
+chmod 0644, "$spooldir/passwd",
+ "$spooldir/acp_dialup",
+;
+chmod 0600, "$spooldir/master.passwd",
+ "$spooldir/acp_passwd",
+ "$spooldir/shadow",
+ "$spooldir/users",
+;
+
+if ( $icradiusmachines ) {
+ my $sth = $icradius_dbh->prepare("DELETE FROM radcheck");
+ $sth->execute or die "Can't reset radcheck table: ". $sth->errstr;
+ my $sth2 = $icradius_dbh->prepare("DELETE FROM radreply");
+ $sth2->execute or die "Can't reset radreply table: ". $sth2->errstr;
+}
+
+setpriority(0,0,10);
+
+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+)$/ ) {
+
+ die "Non-root user ". $svc_acct->username. " has 0 UID!"
+ if $svc_acct->uid == 0 && $svc_acct->username ne 'root';
+
+ ###
+ # 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 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 SHADOW FILE HERE
+ print SHADOW join(":",
+ $svc_acct->username,
+ $cpassword,
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ ), "\n";
+
+ }
+
+ if ( $svc_acct->slipip ne '' ) {
+
+ ###
+ # FORMAT OF THE ACP_* FILES HERE
+ print ACP_PASSWD join(":",
+ $svc_acct->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 $svc_acct->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
+ $svc_acct->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);
+ }
+
+ ###
+ # ICRADIUS export
+ if ( $icradiusmachines ) {
+
+ my $sth = $icradius_dbh->prepare(
+ "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ".
+ join(", ", map { $icradius_dbh->quote( $_ ) } (
+ '',
+ $svc_acct->username,
+ "Password",
+ $svc_acct->_password,
+ ) ). " )"
+ );
+ $sth->execute or die "Can't insert into radcheck table: ". $sth->errstr;
+
+ foreach my $attribute ( keys %radcheck ) {
+ my $sth = $icradius_dbh->prepare(
+ "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ".
+ join(", ", map { $icradius_dbh->quote( $_ ) } (
+ '',
+ $svc_acct->username,
+ $attribute,
+ $radcheck{$attribute},
+ ) ). " )"
+ );
+ $sth->execute or die "Can't insert into radcheck table: ". $sth->errstr;
+ }
+
+ foreach my $attribute ( keys %radreply ) {
+ my $sth = $icradius_dbh->prepare(
+ "INSERT INTO radreply (id, UserName, Attribute, Value) VALUES ( ".
+ join(", ", map { $icradius_dbh->quote( $_ ) } (
+ '',
+ $svc_acct->username,
+ $attribute,
+ $radreply{$attribute},
+ ) ). " )"
+ );
+ $sth->execute or die "Can't insert into radreply table: ". $sth->errstr;
+ }
+
+ }
+
+ }
+
+}
+
+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);
+
+close MASTER;
+close PASSWD;
+close SHADOW;
+close ACP_DIALUP;
+close ACP_PASSWD;
+close USERS;
+
+###
+# export stuff
+#
+
+my($shellmachine);
+foreach $shellmachine (@shellmachines) {
+ my $scp = new Net::SCP;
+ $scp->scp("$spooldir/passwd","root\@$shellmachine:/etc/passwd.new")
+ or die "scp error: ". $scp->{errstr};
+ $scp->scp("$spooldir/shadow","root\@$shellmachine:/etc/shadow.new")
+ or die "scp error: ". $scp->{errstr};
+ ssh("root\@$shellmachine",
+ "( ".
+ "mv /etc/passwd.new /etc/passwd; ".
+ "mv /etc/shadow.new /etc/shadow; ".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($bsdshellmachine);
+foreach $bsdshellmachine (@bsdshellmachines) {
+ 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; ".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($nismachine);
+foreach $nismachine (@nismachines) {
+ 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; ".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($erpcdmachine);
+foreach $erpcdmachine (@erpcdmachines) {
+ 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\'".
+ " )"
+ )
+ == 0 or die "ssh error: $!";
+}
+
+my($radiusmachine);
+foreach $radiusmachine (@radiusmachines) {
+ 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: $!";
+}
+
+foreach my $icradiusmachine ( @icradiusmachines ) {
+ my( $machine, $db, $user, $pass ) = split(/\s+/, $icradiusmachine);
+ chdir $icradius_mysqlsource or die "Can't cd $icradius_mysqlsource: $!";
+ open(WRITER,"|ssh root\@$machine mysql -v --user=$user -p $db");
+ my $oldfh = select WRITER; $|=1; select $oldfh;
+ print WRITER "$pass\n";
+ sleep 2;
+ print WRITER "LOCK TABLES radcheck WRITE, radreply WRITE;\n";
+ foreach my $file ( glob("radcheck.*") ) {
+ my $scp = new Net::SCP;
+ $scp->scp($file,"root\@$machine:$icradius_mysqldest/$db/$file")
+ or die "scp error: ". $scp->{errstr};
+ }
+ foreach my $file ( glob("radreply.*") ) {
+ my $scp = new Net::SCP;
+ $scp->scp($file,"root\@$machine:$icradius_mysqldest/$db/$file")
+ or die "scp error: ". $scp->{errstr};
+ }
+ close WRITER;
+}
+
+unlink $spoollock;
+flock(EXPORT,LOCK_UN);
+close EXPORT;
+
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct.import,v 1.14 2001-05-07 15:24:15 ivan Exp $
+#
+# 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
+#
+# $Log: svc_acct.import,v $
+# Revision 1.14 2001-05-07 15:24:15 ivan
+# s/!/*/
+#
+# Revision 1.13 2001/05/05 08:51:16 ivan
+# http://www.sisd.com/freeside/list-archive/msg01915.html
+#
+# Revision 1.12 2001/04/22 01:56:15 ivan
+# get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)
+#
+# Revision 1.11 2000/06/29 12:27:01 ivan
+# s/password/_password/ for PostgreSQL wasn't done in the import.
+#
+# Revision 1.10 2000/06/28 12:32:30 ivan
+# allow RADIUS lines with "Auth-Type = Local" too
+#
+# Revision 1.8 2000/02/03 05:16:52 ivan
+# beginning of DNS and Apache support
+#
+# Revision 1.7 1999/07/08 02:32:26 ivan
+# import fix, noticed by Ben Leibig and Joel Griffiths
+#
+# Revision 1.6 1999/07/08 01:49:00 ivan
+# updates to avoid -w warnings from Joel Griffiths <griff@aver-computer.com>
+#
+# Revision 1.5 1999/03/25 08:42:19 ivan
+# import stuff uses Term::Query and spits out (some kinds of) nonsensical input
+#
+# Revision 1.4 1999/03/24 00:43:38 ivan
+# die if no relevant services
+#
+# Revision 1.3 1998/12/10 07:23:16 ivan
+# use FS::Conf, need user (for datasrc)
+#
+# Revision 1.2 1998/10/13 12:07:51 ivan
+# Assigns password from the shadow file for RADIUS password "UNIX"
+#
+
+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;
+
+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).
+END
+my($ppp_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Some accounts have entries in passwd and users, but with Port-Limit 2 (or
+more).
+END
+my($isdn_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Some accounts might have entries in users only (Port-Limit 1)
+END
+my($oppp_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Some accounts might have entries in users only (Port-Limit >= 2)
+END
+my($oisdn_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+POP mail accounts have entries in passwd only, and have a particular shell.
+END
+my($pop_shell)=&getvalue("Enter that shell:");
+my($popmail_svcpart)=&getpart;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Everything else in passwd is a shell account.
+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");
+
+print "\n\n", <<END;
+Enter the location and name of your radius "users" file, for example
+"radius.isp.com:/etc/raddb/users"
+END
+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 {
+ $^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");
+open(USERS,"<$spooldir/users.import");
+
+my(%upassword,%ip,%allparam);
+my(%param,$username);
+while (<USERS>) {
+ chop;
+ next if /^\s*$/;
+ next if /^\s*#/;
+ if ( /^\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),$3,$5);
+ $password = '' if $password eq 'UNIX';
+ $upassword{$username}=$password;
+ undef %param;
+ } else {
+ die "2Unexpected line in users.import: $_";
+ }
+ while (<USERS>) {
+ chop;
+ if ( /^\s*$/ ) {
+ 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*$/ ) {
+ my($attribute,$value)=($1,$2);
+ $attribute =~ s/\-/_/g;
+ $param{'radius_'.$attribute}=$value;
+ } else {
+ die "3Unexpected line in users.import: $_";
+ }
+ }
+}
+#? incase there isn't a terminating blank line ?
+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;
+}
+
+while (<PASSWD>) {
+ chop;
+ my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/);
+ my($password)=$upassword{$username} || $password{$username};
+
+ my($maxb)=${$allparam{$username}}{'radius_Port_Limit'};
+ my($svcpart);
+ if ( exists $upassword{$username} ) {
+ if ( $maxb >= 2 ) {
+ $svcpart = $isdn_svcpart
+ } elsif ( ! $maxb || $maxb == 1 ) {
+ $svcpart = $ppp_svcpart
+ } else {
+ die "Illegal Port-Limit in users ($username)!\n";
+ }
+ } elsif ( $shell eq $pop_shell ) {
+ $svcpart = $popmail_svcpart;
+ } else {
+ $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,
+ 'slipip' => $ip{$username},
+ %{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ die $error if $error;
+
+ delete $allparam{$username};
+ delete $upassword{$username};
+}
+
+#my($username);
+foreach $username ( keys %upassword ) {
+ my($password)=$upassword{$username};
+
+ my($maxb)=${$allparam{$username}}{'radius_Port_Limit'} || 0;
+ my($svcpart);
+ if ( $maxb == 2 ) {
+ $svcpart = $oisdn_svcpart
+ } elsif ( ! $maxb || $maxb == 1 ) {
+ $svcpart = $oppp_svcpart
+ } else {
+ die "Illegal Port-Limit in users!\n";
+ }
+
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'slipip' => $ip{$username},
+ %{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ die $error, if $error;
+
+ delete $allparam{$username};
+ delete $upassword{$username};
+}
+
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.import user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_sm.export,v 1.10 2001-05-08 10:44:17 ivan Exp $
+#
+# Create and export config files for sendmail, qmail
+#
+# (used to) 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
+#
+# $Log: svc_acct_sm.export,v $
+# Revision 1.10 2001-05-08 10:44:17 ivan
+# fix for OO Net::SCP
+#
+# Revision 1.9 2001/04/22 01:56:15 ivan
+# get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)
+#
+# Revision 1.8 2000/07/06 03:37:24 ivan
+# don't error out on invalid svc_acct_sm.domuid's that can't be matched in
+# svc_acct.uid - just warn.
+#
+# Revision 1.7 2000/07/03 09:13:10 ivan
+# get rid of double sendmailrestart invocation; no need for multiple sessions
+#
+# Revision 1.6 2000/07/03 09:09:14 ivan
+# typo
+#
+# Revision 1.5 2000/07/03 09:03:14 ivan
+# added sendmailrestart and sendmailconfigpath config files
+#
+# Revision 1.4 2000/06/29 14:02:29 ivan
+# add sendmailrestart configuration file
+#
+# Revision 1.3 2000/06/12 08:37:56 ivan
+# sendmail fix from Jeff Finucane
+#
+# Revision 1.2 1998/12/10 07:23:17 ivan
+# use FS::Conf, need user (for datasrc)
+#
+
+use strict;
+use vars qw($conf);
+use Fcntl qw(:flock);
+use Net::SSH qw(ssh);
+use Net::SCP qw(scp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$conf = new FS::Conf;
+
+my($shellmachine, @qmailmachines);
+if ( $conf->exists('qmailmachines') ) {
+ $shellmachine = $conf->config('shellmachine');
+ @qmailmachines = $conf->config('qmailmachines');
+}
+
+my(@sendmailmachines, $sendmailconfigpath, $sendmailrestart);
+if ( $conf->exists('sendmailmachines') ) {
+ @sendmailmachines = $conf->config('sendmailmachines');
+ $sendmailconfigpath = $conf->config('sendmailconfigpath') || '/etc';
+ $sendmailrestart = $conf->config('sendmailrestart');
+}
+
+my $mydomain = $conf->config('domain');
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct_sm.export.lock.". datasrc;
+
+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";
+
+( 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});
+ unless ( $svc_acct ) {
+ warn "WARNING: couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum ".
+ $svc_acct_sm->svcnum. ") - corruped database?\n";
+ next;
+ }
+ 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) {
+ 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";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_sm.import,v 1.9 2001-04-22 01:56:15 ivan Exp $
+#
+# 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
+#
+# $Log: svc_acct_sm.import,v $
+# Revision 1.9 2001-04-22 01:56:15 ivan
+# get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)
+#
+# Revision 1.8 2000/12/03 15:14:00 ivan
+# bugfixes from Jeff Finucane <jeff@cmh.net>, thanks!
+#
+# Revision 1.7 2000/06/29 10:51:52 ivan
+# oops, silly mistake
+#
+# Revision 1.6 2000/06/29 10:48:25 ivan
+# make svc_acct_sm skip blank lines in sendmail import
+#
+# Revision 1.5 2000/02/03 05:16:52 ivan
+# beginning of DNS and Apache support
+#
+# Revision 1.4 1999/03/25 08:42:20 ivan
+# import stuff uses Term::Query and spits out (some kinds of) nonsensical input
+#
+# Revision 1.3 1999/03/24 00:51:55 ivan
+# die if no relevant services... cvspain
+#
+# Revision 1.2 1998/12/10 07:23:18 ivan
+# use FS::Conf, need user (for datasrc)
+#
+
+use strict;
+use vars qw(%d_part_svc %m_part_svc);
+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;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+my(%mta) = (
+ 1 => "qmail",
+ 2 => "sendmail",
+);
+
+###
+
+%d_part_svc =
+ map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+%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\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\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";
+$^W=0; #Term::Query isn't -w-safe
+my $mta = query ":", 'irk', [ keys %mta ];
+$^W=1;
+
+if ( $mta{$mta} eq "qmail" ) {
+
+ print "\n\n", <<END;
+Enter the location and name of your qmail control directory, for example
+"mail.isp.com:/var/qmail/control"
+END
+ my($control)=&getvalue(":");
+ iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import");
+# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import");
+ iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import");
+
+# print "\n\n", <<END;
+#Enter the name of the machine with your user .qmail files, for example
+#"mail.isp.com"
+#END
+# print ":";
+# my($shellmachine)=&getvalue;
+
+} elsif ( $mta{$mta} eq "sendmail" ) {
+
+ print "\n\n", <<END;
+Enter the location and name of your sendmail virtual user table, for example
+"mail.isp.com:/etc/virtusertable"
+END
+ 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
+ my($sendmail_cw)=&getvalue(":");
+ iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import");
+
+} else {
+ die "Unknown MTA!\n";
+}
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; #Term::Query isn't -w-safe
+ my $data = query $prompt, '';
+ $^W=1;
+ $data;
+}
+
+print "\n\n";
+
+###
+
+$FS::svc_domain::whois_hack=1;
+$FS::svc_acct_sm::nossh_hack=1;
+
+if ( $mta{$mta} eq "qmail" ) {
+ open(RCPTHOSTS,"<$spooldir/rcpthosts.import")
+ or die "Can't open $spooldir/rcpthosts.import: $!";
+} elsif ( $mta{$mta} eq "sendmail" ) {
+ open(RCPTHOSTS,"<$spooldir/sendmail.cw.import")
+ or die "Can't open $spooldir/sendmail.cw.import: $!";
+} else {
+ die "Unknown MTA!\n";
+}
+
+my(%svcnum);
+
+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 = new FS::svc_domain ({
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ });
+ my $error = $svc_domain->insert;
+ #warn $error if $error;
+ die $error if $error;
+ }
+ $svcnum{$domain}=$svc_domain->svcnum;
+}
+close RCPTHOSTS;
+
+#these two loops have enough similar parts they should probably be merged
+if ( $mta{$mta} eq "qmail" ) {
+
+ open(VD_FIX,">$spooldir/virtualdomains.FIX");
+ print VD_FIX "#!/usr/bin/perl\n";
+
+ open(VIRTUALDOMAINS,"<$spooldir/virtualdomains.import")
+ or die "Can't open $spooldir/virtualdomains.import: $!";
+ while (<VIRTUALDOMAINS>) {
+ next if /^#/;
+ /^\.?([\w\-\.]+):(\w+)(\-([\w\-\.]+))?$/
+ #or do { warn "Strange virtualdomains line: $_"; next; };
+ or die "Strange virtualdomains line: $_";
+ my($domain,$username,$dash_ext,$extension)=($1,$2,$3,$4);
+ $dash_ext ||= '';
+ $extension ||= '';
+ my($svc_acct)=qsearchs('svc_acct',{'username'=>$username});
+ unless ( $svc_acct ) {
+ #warn "Unknown user $username in virtualdomains; skipping\n";
+ #die "Unknown user $username in virtualdomains; skipping\n";
+ next;
+ }
+ if ( $domain ne $extension ) {
+ #warn "virtualdomains line $domain:$username$dash_ext changed to $domain:$username-$domain\n";
+ my($dir)=$svc_acct->dir;
+ my($qdomain)=$domain;
+ $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
+ #example to move .qmail files for virtual domains to their new location
+ #dry run
+ #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; print " $old -> $a\n"; }\'');
+ #the real thing
+ #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; rename $old, $a; }\'');
+ print VD_FIX <<END;
+foreach \$file (<$dir/.qmail$dash_ext-*>) {
+ \$old = \$file;
+ \$file =~ s/\.qmail$dash_ext\-/\.qmail\-$qdomain\-/;
+ rename \$old, \$file;
+}
+END
+ }
+
+ unless ( exists $svcnum{$domain} ) {
+ my($svc_domain) = new FS::svc_domain ({
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ });
+ my $error = $svc_domain->insert;
+ #warn $error if $error;
+ die $error if $error;
+ $svcnum{$domain}=$svc_domain->svcnum;
+ }
+
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
+ 'domsvc' => $svcnum{$domain},
+ 'domuid' => $svc_acct->uid,
+ 'domuser' => '*',
+ 'svcpart' => $mailalias_svcpart,
+ });
+ my($error)='';
+ $error=$svc_acct_sm->insert;
+ #warn $error if $error;
+ die $error, ", domain $domain" if $error;
+ }
+ close VIRTUALDOMAINS;
+ close VD_FIX;
+
+} elsif ( $mta{$mta} eq "sendmail" ) {
+
+ open(VIRTUSERTABLE,"<$spooldir/virtusertable.import")
+ or die "Can't open $spooldir/virtusertable.import: $!";
+ while (<VIRTUSERTABLE>) {
+ next if /^#/; #comments?
+ 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);
+ my($svc_acct)=qsearchs('svc_acct',{'username'=>$username});
+ unless ( $svc_acct ) {
+ #warn "Unknown user $username in virtusertable";
+ die "Unknown user $username in virtusertable";
+ next;
+ }
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
+ 'domsvc' => $svcnum{$domain},
+ 'domuid' => $svc_acct->uid,
+ 'domuser' => $domuser || '*',
+ 'svcpart' => $mailalias_svcpart,
+ });
+ my($error)='';
+ $error=$svc_acct_sm->insert;
+ #warn $error if $error;
+ die $error if $error;
+ }
+ close VIRTUSERTABLE;
+
+} else {
+ die "Unknown MTA!\n";
+}
+
+#open(RECIPIENTMAP,"<$spooldir/recipientmap.import");
+#close RECIPIENTMAP;
+
+print "\n\n", <<END if $mta{$mta} eq "qmail";
+Don\'t forget to run $spooldir/virtualdomains.FIX before using
+$spooldir/virtualdomains !
+END
+
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct_sm.import user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: svc_domain.import,v 1.2 2001-04-22 01:56:15 ivan Exp $
+
+use strict;
+use vars qw( %d_part_svc );
+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::domain_record;
+#use FS::svc_acct;
+#use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+%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";
+$^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", <<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(":");
+ iscp("root\@$named_conf","$spooldir/named.conf.import");
+
+my $named_machine = (split(/:/, $named_conf))[0];
+
+print "\n\n";
+
+##
+
+$FS::svc_domain::whois_hack=1;
+
+open(NAMED_CONF,"<$spooldir/named.conf.import")
+ or die "Can't open $spooldir/named.conf.import: $!";
+
+while (<NAMED_CONF>) {
+ next unless /^\s*options/;
+}
+my $directory;
+while (<NAMED_CONF>) {
+ last if /^\s*directory\s+\"([\/\w+]+)\";/;
+}
+$directory = $1 or die "can't locate directory in named.conf!";
+whlie (<NAMED_CONF>) {
+ next unless /^\s*zone\s+\"([\w\.\-]+)\"\s+\{/;
+ my $zone = $1;
+ while (<NAMED_CONF>) {
+ my $type;
+ if ( /^\s*type\s+(master|slave)\s*\;/ ) {
+ $type = $1;
+ }
+ if ( /^\s*file\s+\"([\w\.\-]+)\"\s*\;/ && $type eq 'master' ) {
+
+ #
+ # (add svc_domain)
+ my $file = $1;
+ iscp("root\@$named_machine:$directory/$file","$spooldir/$file.import");
+ open(ZONE,"<$spooldir/$file.import")
+ or die "Can't open $spooldir/$file.import: $!";
+ while (<ZONE>) {
+ # (add domain_record)
+ }
+
+ #
+
+ }
+
+ last if /^\s*\}\s*\;/;
+ }
+}
+
+##
+
+sub usage {
+ die "Usage:\n\n svc_domain.import user\n";
+}
+
--- /dev/null
+Silicon Interactive Software Design
+15 Skyview Way
+Newtown, PA 18940
+
--- /dev/null
+domain.tld
--- /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
+DBI:mysql:freeside
+freeside
+put_your_password_here
--- /dev/null
+/bin/csh
+/bin/sh
--- /dev/null
+#!/usr/bin/perl -w
+
+# Template for importing legacy customer data
+#
+# $Id: TEMPLATE_cust_main.import,v 1.3 1999-03-26 13:15:56 ivan Exp $
+#
+# ivan@sisd.com 98-aug-17 - 20
+#
+# $Log: TEMPLATE_cust_main.import,v $
+# Revision 1.3 1999-03-26 13:15:56 ivan
+# s/create/new/, use all necessary FS::table_names to avoid warnings
+#
+# Revision 1.2 1998/12/16 05:29:45 ivan
+# adminsuidsetup now need user
+#
+
+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 FS::cust_svc;
+use FS::svc_acct;
+use FS::pkg_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# use these for the imported cust_main records (unless you have these in legacy
+# data)
+my($agentnum)=4;
+my($refnum)=5;
+
+# map from legacy billing data to pkgpart, maps imported field
+# LegacyBillingData to pkgpart. your names and pkgparts will be different
+my(%pkgpart)=(
+ 'Employee' => 10,
+ 'Business' => 11,
+ 'Individual' => 12,
+ 'Basic PPP' => 13,
+ 'Slave' => 14,
+ 'Co-Located Server' => 15,
+ 'Virtual Web' => 16,
+ 'Perk Mail' => 17,
+ 'Credit Hold' => 18,
+);
+
+my($file)="legacy_file";
+
+open(CLIENT,$file)
+ or die "Can't open $file: $!";
+
+# put a tab-separated header atop the file, or define @fields
+# (use these names or change them below)
+#
+# for cust_main
+# custnum - unique
+# last - (name)
+# first - (name)
+# company
+# address1
+# address2
+# city
+# state
+# zip
+# country
+# daytime - (phone)
+# night - (phone)
+# fax
+# payby - CARD, BILL or COMP
+# payinfo - Credit card #, P.O. # or COMP authorization
+# paydate - Expiration
+# tax - 'Y' for tax exempt
+# for cust_pkg
+# LegacyBillingData - maps via %pkgpart above to a pkgpart
+# for svc_acct
+# username
+
+my($header);
+$header=<CLIENT>;
+chop $header;
+my(@fields)=map { /^\s*(.*[^\s]+)\s*$/; $1 } split(/\t/,$header);
+#print join("\n",@fields);
+
+my($error);
+my($link,$line)=(0,0);
+while (<CLIENT>) {
+ chop;
+ next if /^[\s\t]*$/; #skip any blank lines
+
+ #define %svc hash for this record
+ my(@record)=split(/\t/);
+ my(%svc);
+ foreach (@fields) {
+ $svc{$_}=shift @record;
+ }
+
+ # might need to massage some data like this
+ $svc{'payby'} =~ s/^Credit Card$/CARD/io;
+ $svc{'payby'} =~ s/^Check$/BILL/io;
+ $svc{'payby'} =~ s/^Cash$/BILL/io;
+ $svc{'payby'} =~ s/^$/BILL/o;
+ $svc{'First'} =~ s/&/and/go;
+ $svc{'Zip'} =~ s/\s+$//go;
+
+ my($cust_main) = new FS::cust_main ( {
+ 'custnum' => $svc{'custnum'},
+ 'agentnum' => $agentnum,
+ 'last' => $svc{'last'},
+ 'first' => $svc{'first'},
+ 'company' => $svc{'company'},
+ 'address1' => $svc{'address1'},
+ 'address2' => $svc{'address2'},
+ 'city' => $svc{'city'},
+ 'state' => $svc{'state'},
+ 'zip' => $svc{'zip'},
+ 'country' => $svc{'country'},
+ 'daytime' => $svc{'daytime'},
+ 'night' => $svc{'night'},
+ 'fax' => $svc{'fax'},
+ 'payby' => $svc{'payby'},
+ 'payinfo' => $svc{'payinfo'},
+ 'paydate' => $svc{'paydate'},
+ 'payname' => $svc{'payname'},
+ 'tax' => $svc{'tax'},
+ 'refnum' => $refnum,
+ } );
+
+ $error=$cust_main->insert;
+
+ if ( $error ) {
+ warn $cust_main->_dump;
+ warn map "$_: ". $svc{$_}. "|\n", keys %svc;
+ die $error;
+ }
+
+ my($cust_pkg)=new FS::cust_pkg ( {
+ 'custnum' => $svc{'custnum'},
+ 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
+ 'setup' => '',
+ 'bill' => '',
+ 'susp' => '',
+ 'expire' => '',
+ 'cancel' => '',
+ } );
+
+ $error=$cust_pkg->insert;
+ if ( $error ) {
+ warn $svc{'LegacyBillingData'};
+ die $error;
+ }
+
+ unless ( $svc{'username'} ) {
+ warn "Empty login";
+ } else {
+ #find svc_acct record (imported with bin/svc_acct.import) for this username
+ my($svc_acct)=qsearchs('svc_acct',{'username'=>$svc{'username'}});
+ unless ( $svc_acct ) {
+ warn "username ", $svc{'username'}, " not found\n";
+ } else {
+ #link to the cust_pkg record we created above
+
+ #find cust_svc record for this svc_acct record
+ my($o_cust_svc)=qsearchs('cust_svc',{
+ 'svcnum' => $svc_acct->svcnum,
+ 'pkgnum' => '',
+ } );
+ unless ( $o_cust_svc ) {
+ warn "No unlinked cust_svc for svcnum ", $svc_acct->svcnum;
+ } else {
+
+ #make sure this svcpart is in pkgpart
+ my($pkg_svc)=qsearchs('pkg_svc',{
+ 'pkgpart' => $pkgpart{$svc{'LegacyBillingData'}},
+ 'svcpart' => $o_cust_svc->svcpart,
+ 'quantity' => 1,
+ });
+ unless ( $pkg_svc ) {
+ warn "login ", $svc{'username'}, ": No svcpart ", $o_cust_svc->svcpart,
+ " for pkgpart ", $pkgpart{$svc{'Acct. Type'}}, "\n" ;
+ } else {
+
+ #create new cust_svc record linked to cust_pkg record
+ my($n_cust_svc) = new FS::cust_svc ({
+ 'svcnum' => $o_cust_svc->svcnum,
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'svcpart' => $pkg_svc->svcpart,
+ });
+ my($error) = $n_cust_svc->replace($o_cust_svc);
+ die $error if $error;
+ $link++;
+ }
+ }
+ }
+ }
+
+ $line++;
+
+}
+
+warn "\n$link of $line lines linked\n";
+
+# ---
+
+sub usage {
+ die "Usage:\n\n cust_main.import user\n";
+}
--- /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 VERSION
+
+$Id: table_template-svc.pm,v 1.1 1999-08-04 08:03:03 ivan Exp $
+
+=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.
+
+=head1 HISTORY
+
+ivan@voicenet.com 97-jul-21
+
+$Log: table_template-svc.pm,v $
+Revision 1.1 1999-08-04 08:03:03 ivan
+move table subclass examples out of production directory
+
+Revision 1.4 1998/12/30 00:30:48 ivan
+svc_ stuff is more properly OO - has a common superclass FS::svc_Common
+
+Revision 1.2 1998/11/15 04:33:01 ivan
+updates for newest versoin
+
+
+=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 VERSION
+
+$Id: table_template.pm,v 1.2 2000-10-27 20:15:50 ivan Exp $
+
+=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
+[ 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
+#!/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
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_passwd
+#
+# portions of this script are copied from the `passwd' script in the original
+# (perl 4) camel book, now archived at
+# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd
+#
+# ivan@sisd.com 98-mar-8
+#
+# password lengths 0,255 instead of 6,8 - we'll let the server process
+# check the data ivan@sisd.com 98-jul-17
+
+use strict;
+use Getopt::Std;
+use Socket;
+use IO::Handle;
+use vars qw($opt_f $opt_s);
+
+my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_socket";
+my($freeside_uid)=scalar(getpwnam('freeside'));
+
+$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
+$ENV{'SHELL'} = '/bin/sh';
+$ENV{'IFS'} = " \t\n";
+$ENV{'CDPATH'} = '';
+$ENV{'ENV'} = '';
+$ENV{'BASH_ENV'} = '';
+
+$SIG{__DIE__}= sub { system '/bin/stty', 'echo'; };
+
+die "passwd program isn't running setuid to freeside\n" if $> != $freeside_uid;
+
+unshift @ARGV, "-f" if $0 =~ /chfn$/;
+unshift @ARGV, "-s" if $0 =~ /chsh$/;
+
+getopts('fs');
+
+my($me)='';
+if ( $_ = shift(@ARGV) ) {
+ /^(\w{2,8})$/;
+ $me = $1;
+}
+die "You can't change the password for $me." if $me && $<;
+$me = (getpwuid($<))[0] unless $me;
+
+my($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell)=
+ getpwnam $me;
+
+my($old_password,$new_password,$new_gecos,$new_shell);
+
+if ( $opt_f || $opt_s ) {
+ system '/bin/stty', '-echo';
+ print "Password:";
+ $old_password=<STDIN>;
+ system '/bin/stty', 'echo';
+ chop($old_password);
+ #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
+ $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
+ $old_password = $1;
+
+ $new_password = '';
+
+ if ( $opt_f ) {
+ print "\nChanging gecos for $me.\n";
+ print "Gecos [", $gcos, "]: ";
+ $new_gecos=<STDIN>;
+ chop($new_gecos);
+ $new_gecos ||= $gcos;
+ $new_gecos =~ /^(.{0,255})$/ or die "\nIllegal gecos.\n";
+ } else {
+ $new_gecos = '';
+ }
+
+ if ( $opt_s ) {
+ print "\nChanging shell for $me.\n";
+ print "Shell [", $shell, "]: ";
+ $new_shell=<STDIN>;
+ chop($new_shell);
+ $new_shell ||= $shell;
+ $new_shell =~ /^(.{0,255})$/ or die "\nIllegal shell.\n";
+ } else {
+ $new_shell = '';
+ }
+
+} else {
+
+ print "Changing password for $me.\n";
+ print "Old password:";
+ system '/bin/stty', '-echo';
+ $old_password=<STDIN>;
+ chop $old_password;
+ #$old_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
+ $old_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
+ $old_password = $1;
+ print "\nEnter the new password (minimum of 6, maximum of 8 characters)\n";
+ print "Please use a combination of upper and lowercase letters and numbers.\n";
+ print "New password:";
+ $new_password=<STDIN>;
+ chop($new_password);
+ #$new_password =~ /^(.{6,8})$/ or die "\nIllegal password.\n";
+ $new_password =~ /^(.{0,255})$/ or die "\nIllegal password.\n";
+ $new_password = $1;
+ print "\nRe-enter new password:";
+ my($check_new_password);
+ $check_new_password=<STDIN>;
+ chop($check_new_password);
+ die "\nThey don't match; try again.\n" unless $check_new_password eq $new_password;
+
+ $new_gecos='';
+ $new_shell='';
+}
+print "\n";
+
+system '/bin/stty', 'echo';
+
+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,$new_gecos,$new_shell),"\n";
+SOCK->flush;
+my($error);
+$error = <SOCK>;
+chop $error;
+
+if ($error) {
+ print "\nUpdate error: $error\n";
+} else {
+ print "\nUpdate sucessful.\n";
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_passwd_server
+#
+# portions of this script are copied from the `passwd' script in the original
+# (perl 4) camel book, now archived at
+# http://www.perl.com/CPAN/scripts/nutshell/ch6/passwd
+#
+# ivan@sisd.com 98-mar-9
+#
+# crypt-aware, s/password/_password/; ivan@sisd.com 98-aug-23
+
+use strict;
+use IO::Handle;
+use Net::SSH qw(sshopen2);
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs);
+use FS::svc_acct;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my($shellmachine)=shift or die &usage;
+
+#causing trouble for some folks
+#$SIG{CHLD} = sub { wait() };
+
+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);
+ while (1) {
+ my($username,$old_password,$new_password,$new_gecos,$new_shell);
+ defined($username=<$reader>) or last;
+ defined($old_password=<$reader>) or last;
+ defined($new_password=<$reader>) or last;
+ defined($new_gecos=<$reader>) or last;
+ defined($new_shell=<$reader>) or last;
+ chop($username);
+ chop($old_password);
+ chop($new_password);
+ chop($new_gecos);
+ chop($new_shell);
+ my($svc_acct);
+
+ #need to try both $old_password and encrypted $old_password
+ #maybe the crypt function in svc_acct.export needs to be a library?
+ my $salt = substr($old_password,0,2);
+ my $cold_password = crypt($old_password,$salt);
+ $svc_acct=qsearchs('svc_acct',{'username'=>$username,
+ '_password'=>$old_password,
+ } )
+ || qsearchs('svc_acct',{'username'=>$username,
+ '_password'=>$cold_password,
+ } );
+ unless ( $svc_acct ) { print $writer "Incorrect password.\n"; next; }
+
+ my(%hash)=$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;
+ $new_svc_acct->setfield('shell',$new_shell) if $new_shell;
+ my($error)=$new_svc_acct->replace($svc_acct);
+ print $writer $error,"\n";
+ }
+ close $writer;
+ close $reader;
+ sleep 60;
+ warn "Connection to $shellmachine lost! Reconnecting...\n";
+}
+
+sub usage {
+ die "Usage:\n\n fs_passwd_server user shellmachine\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_passwdd
+#
+# This is run REMOTELY over ssh by fs_passwd_server.
+#
+# ivan@sisd.com 98-mar-9
+
+use strict;
+use Socket;
+
+my($fs_passwdd_socket)="/usr/local/freeside/fs_passwdd_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 $uaddr = sockaddr_un($fs_passwdd_socket);
+my $proto = getprotobyname('tcp');
+
+socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
+unlink($fs_passwdd_socket);
+bind(Server, $uaddr) or die "bind: $!";
+listen(Server,SOMAXCONN) or die "listen: $!";
+
+my($paddr);
+for ( ; $paddr = accept(Client,Server); close Client) {
+ my($me,$old_password,$new_password,$new_gecos,$new_shell);
+
+ $me=<Client>;
+ $old_password=<Client>;
+ $new_password=<Client>;
+ $new_gecos=<Client>;
+ $new_shell=<Client>;
+
+ print $me,$old_password,$new_password,$new_gecos,$new_shell;
+ my($error);
+
+ $error=<STDIN>;
+
+ print Client $error;
+ close Client;
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# ivan@sisd.com 98-mar-23
+
+use strict;
+use Date::Parse; #but hopefully not
+
+$|=1;
+
+my($file,$pos)=@_;
+open(FILE,"<$file") or die "Can't open $file: $!";
+seek(FILE,$pos,0) or die "Can't seek: $!";
+
+my($datestr);
+my(%param);
+
+$SIG{'HUP'} = sub { print "EOF\n"; exit; };
+
+while (1) {
+
+ while (<FILE>) {
+ next if /^$/;
+ if ( /^\S/ ) {
+ chop($datestr=$_);
+ undef %param;
+ } else {
+ warn "Unexpected line: $_";
+ }
+ while (<FILE>) {
+ if ( /^$/ ) {
+ #if ( $param{'Acct-Status-Type'} eq 'Stop' ) {
+ print join("\t",
+ tell FILE,
+ %param,
+ ),"\n";
+ #}
+ last;
+ } elsif ( /^\s+([\w\-]+)\s\=\s\"?([\w\.\-]+)\"?\s*$/ ) {
+ $param{$1}=$2;
+ } else {
+ warn "Unexpected line: $_";
+ }
+
+ }
+
+ }
+ sleep 1;
+ seek(FILE,0,1);
+}
+
+
--- /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',
+ 'PERM_RWX' => '750',
+);
--- /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;
+
+$VERSION = '0.01';
+
+@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,
+ 'pkgpart' => $pkgpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'popnum' => $popnum,
+ } );
+
+=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
+
+=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;
+
+ chop ( my $n_cust_main_county = <SOCK> );
+ my @cust_main_county = map {
+ chop ( my $taxnum = <SOCK> );
+ chop ( my $state = <SOCK> );
+ chop ( my $county = <SOCK> );
+ chop ( my $country = <SOCK> );
+ {
+ 'taxnum' => $taxnum,
+ 'state' => $state,
+ 'county' => $county,
+ 'country' => $country,
+ };
+ } 1 .. $n_cust_main_county;
+
+ chop ( my $n_part_pkg = <SOCK> );
+ my @part_pkg = map {
+ chop ( my $pkgpart = <SOCK> );
+ chop ( my $pkg = <SOCK> );
+ {
+ 'pkgpart' => $pkgpart,
+ 'pkg' => $pkg,
+ };
+ } 1 .. $n_part_pkg;
+
+ chop ( my $n_svc_acct_pop = <SOCK> );
+ my @svc_acct_pop = map {
+ chop ( my $popnum = <SOCK> );
+ chop ( my $city = <SOCK> );
+ chop ( my $state = <SOCK> );
+ chop ( my $ac = <SOCK> );
+ chop ( my $exch = <SOCK> );
+ chop ( my $loc = <SOCK> );
+ {
+ 'popnum' => $popnum,
+ 'city' => $city,
+ 'state' => $state,
+ 'ac' => $ac,
+ 'exch' => $exch,
+ 'loc' => $loc,
+ };
+ } 1 .. $n_svc_acct_pop;
+
+ close SOCK;
+
+ \@cust_main_county, \@part_pkg, \@svc_acct_pop;
+}
+
+=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
+ pkgpart
+ username
+ _password
+ 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";
+
+ print SOCK join("\n", map { $hashref->{$_} } qw(
+ first last ss company address1 address2 city county state zip country
+ daytime night fax payby payinfo paydate payname invoicing_list
+ pkgpart username _password popnum
+ ) ), "\n";
+ SOCK->flush;
+
+ chop( my $error = <SOCK> );
+ $error;
+}
+
+=back
+
+=head1 VERSION
+
+$Id: SignupClient.pm,v 1.3 2000-02-02 07:44:00 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<fs_signupd>, L<FS::SignupServer>, L<FS::cust_main>
+
+=cut
+
+1;
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: signup.cgi,v 1.9 2000-12-03 14:29:15 ivan Exp $
+
+use strict;
+use vars qw( @payby $cgi $locales $packages $pops $r $error
+ $last $first $ss $company $address1 $address2 $city $state $county
+ $country $zip $daytime $night $fax $invoicing_list $payby $payinfo
+ $paydate $payname $pkgpart $username $password $popnum
+ $ieak_file $ieak_template $cck_file $cck_template
+ $ac $exch $loc
+ );
+use subs qw( print_form print_okay expselect );
+
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use HTTP::Headers::UserAgent 2.00;
+use FS::SignupClient qw( signup_info new_customer );
+use Text::Template;
+
+#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';
+
+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 = '';
+}
+
+( $locales, $packages, $pops ) = signup_info();
+
+$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 = new_customer ( {
+ 'last' => $last = $cgi->param('last'),
+ 'first' => $first = $cgi->param('first'),
+ 'ss' => $ss = $cgi->param('ss'),
+ 'company' => $company = $cgi->param('company'),
+ 'address1' => $address1 = $cgi->param('address1'),
+ 'address2' => $address2 = $cgi->param('address2'),
+ 'city' => $city = $cgi->param('city'),
+ 'county' => $county,
+ 'state' => $state,
+ 'zip' => $zip = $cgi->param('zip'),
+ 'country' => $country,
+ 'daytime' => $daytime = $cgi->param('daytime'),
+ 'night' => $night = $cgi->param('night'),
+ 'fax' => $fax = $cgi->param('fax'),
+ 'payby' => $payby,
+ 'payinfo' => $payinfo,
+ 'paydate' => $paydate,
+ 'payname' => $payname,
+ 'invoicing_list' => $invoicing_list,
+ 'pkgpart' => $pkgpart = $cgi->param('pkgpart'),
+ 'username' => $username = $cgi->param('username'),
+ '_password' => $password = $cgi->param('_password'),
+ 'popnum' => $popnum = $cgi->param('popnum'),
+ } ) )
+ ? print_form()
+ : 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 = '';
+ $popnum = '';
+
+ print_form;
+}
+
+sub print_form {
+
+ my $r = qq!<font color="#ff0000">*</font>!;
+ my $self_url = $cgi->self_url;
+
+ print $cgi->header( '-expires' => 'now' ), <<END;
+<HTML><HEAD><TITLE>ISP Signup form</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup form</FONT><BR><BR>
+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">
+Contact Information
+<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR>
+ <TH ALIGN="right">${r}Contact name<BR>(last, first)</TH>
+ <TD COLSPAN=3><INPUT TYPE="text" NAME="last" VALUE="$last">,
+ <INPUT TYPE="text" NAME="first" VALUE="$first"></TD>
+ <TD ALIGN="right">SS#</TD>
+ <TD><INPUT TYPE="text" NAME="ss" SIZE=11 VALUE="$ss"></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">${r}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">${r}City</TH>
+ <TD><INPUT TYPE="text" NAME="city" VALUE="$city"></TD>
+ <TH ALIGN="right">${r}State/Country</TH>
+ <TD><SELECT NAME="state" SIZE="1">
+END
+
+ foreach ( @{$locales} ) {
+ print "<OPTION";
+ print " SELECTED" if ( $state eq $_->{'state'}
+ && $county eq $_->{'county'}
+ && $country eq $_->{'country'}
+ );
+ print ">", $_->{'state'};
+ print " (",$_->{'county'},")" if $_->{'county'};
+ print " / ", $_->{'country'};
+ }
+
+ print <<END;
+ </SELECT></TD>
+ <TH>${r}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>$r required fields<BR>
+<BR>Billing information<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=0 WIDTH="100%">
+<TR><TD>
+END
+
+ print qq!<INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"!;
+ my @invoicing_list = split(', ', $invoicing_list );
+ print ' CHECKED'
+ if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list;
+ print '>Postal mail invoice</TD></TR><TR><TD>Email invoice ',
+ qq!<INPUT TYPE="text" NAME="invoicing_list" VALUE="!,
+ join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ qq!"></TD></TR>!;
+
+ print <<END;
+<TR><TD>Billing type</TD></TR></TABLE>
+<TABLE BGCOLOR="#c0c0c0" BORDER=1 WIDTH="100%">
+<TR>
+END
+
+ 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>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"),
+ 'PREPAY' => qq!Prepaid card<BR>${r}<INPUT TYPE="text" NAME="PREPAY_payinfo" VALUE="" MAXLENGTH=80>!,
+ );
+
+ my %paybychecked = (
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $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", $paydate). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $paydate),
+ 'PREPAY' => qq!Prepaid card<BR>${r}<INPUT TYPE="text" NAME="PREPAY_payinfo" VALUE="$payinfo" MAXLENGTH=80>!,
+ );
+
+ for (@payby) {
+ print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
+ if ($payby eq $_) {
+ print qq! CHECKED> $paybychecked{$_}</TD>!;
+ } else {
+ print qq!> $payby{$_}</TD>!;
+ }
+ }
+
+ print <<END;
+</TR></TABLE>$r 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)
+END
+
+ foreach my $package ( @{$packages} ) {
+ print qq!<OPTION VALUE="!, $package->{'pkgpart'}, '"';
+ print " SELECTED" if $pkgpart && ( $package->{'pkgpart'} == $pkgpart );
+ print ">", $package->{'pkg'};
+ }
+
+ print <<END;
+ </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="text" NAME="_password" VALUE="$password">
+ (blank to generate)</TD>
+</TR>
+<TR>
+ <TD ALIGN="right">POP</TD>
+ <TD><SELECT NAME="popnum" SIZE=1><OPTION>
+END
+
+ foreach my $pop ( @{$pops} ) {
+ print qq!<OPTION VALUE="!, $pop->{'popnum'}, '"',
+ ( $popnum && $pop->{'popnum'} == $popnum ) ? ' SELECTED' : '', ">",
+ $pop->{'popnum'}, ": ",
+ $pop->{'city'}, ", ",
+ $pop->{'state'},
+ " (", $pop->{'ac'}, ")/",
+ $pop->{'exch'}, "\n"
+ ;
+ }
+ print <<END;
+ </SELECT></TD>
+</TR>
+</TABLE>
+<BR><BR><INPUT TYPE="submit" VALUE="Signup">
+</FORM></BODY></HTML>
+END
+
+}
+
+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";
+ my $email_name = $1;
+
+ my $pop = pop_info($cgi->param('popnum'))
+ or die "fatal: invalid popnum got past FS::SignupClient::new_customer";
+ ( $ac, $exch, $loc ) = ( $pop->{'ac'}, $pop->{'exch'}, $pop->{'loc'} );
+
+ 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' ), <<END;
+<HTML><HEAD><TITLE>Signup successful</TITLE></HEAD>
+<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>Signup successful</FONT><BR><BR>
+blah blah blah
+</BODY>
+</HTML>
+END
+ }
+}
+
+sub pop_info {
+ my $popnum = shift;
+ my $pop;
+ foreach $pop ( @{$pops} ) {
+ if ( $pop->{'popnum'} == $popnum ) { return $pop; }
+ }
+ '';
+}
+
+sub expselect {
+ my $prefix = shift;
+ my $date = shift || '';
+ my( $m, $y ) = ( 0, 0 );
+ if ( $date =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #PostgreSQL date format
+ ( $m, $y ) = ( $2, $1 );
+ } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
+ ( $m, $y ) = ( $1, $3 );
+ }
+ my $return = qq!<SELECT NAME="$prefix!. qq!_month" SIZE="1">!;
+ for ( 1 .. 12 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $m;
+ $return .= ">$_";
+ }
+ $return .= qq!</SELECT>/<SELECT NAME="$prefix!. qq!_year" SIZE="1">!;
+ for ( 1999 .. 2037 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $y;
+ $return .= ">$_";
+ }
+ $return .= "</SELECT>";
+
+ $return;
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# fs_signupd
+#
+# This is run REMOTELY over ssh by fs_signup_server.
+#
+
+use strict;
+use Socket;
+
+use vars qw( $Debug );
+
+$Debug = 0;
+
+my($fs_signupd_socket)="/usr/local/freeside/fs_signupd_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;
+
+warn "[fs_signupd] Reading locales...\n" if $Debug;
+chomp( my $n_cust_main_county = <STDIN> );
+my @cust_main_county = map {
+ chomp( my $taxnum = <STDIN> );
+ chomp( my $state = <STDIN> );
+ chomp( my $county = <STDIN> );
+ chomp( my $country = <STDIN> );
+ {
+ 'taxnum' => $taxnum,
+ 'state' => $state,
+ 'county' => $county,
+ 'country' => $country,
+ };
+} ( 1 .. $n_cust_main_county );
+
+warn "[fs_signupd] Reading package definitions...\n" if $Debug;
+chomp( my $n_part_pkg = <STDIN> );
+my @part_pkg = map {
+ chomp( my $pkgpart = <STDIN> );
+ chomp( my $pkg = <STDIN> );
+ {
+ 'pkgpart' => $pkgpart,
+ 'pkg' => $pkg,
+ };
+} ( 1 .. $n_part_pkg );
+
+warn "[fs_signupd] Reading POPs...\n" if $Debug;
+chomp( my $n_svc_acct_pop = <STDIN> );
+my @svc_acct_pop = map {
+ chomp( my $popnum = <STDIN> );
+ chomp( my $city = <STDIN> );
+ chomp( my $state = <STDIN> );
+ chomp( my $ac = <STDIN> );
+ chomp( my $exch = <STDIN> );
+ chomp( my $loc = <STDIN> );
+ {
+ 'popnum' => $popnum,
+ 'city' => $city,
+ 'state' => $state,
+ 'ac' => $ac,
+ 'exch' => $exch,
+ 'loc' => $loc,
+ };
+} ( 1 .. $n_svc_acct_pop );
+
+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: $!";
+
+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;
+ print Client join("\n", $n_cust_main_county,
+ map {
+ $_->{taxnum},
+ $_->{state},
+ $_->{county},
+ $_->{country},
+ } @cust_main_county
+ ), "\n";
+
+ print Client join("\n", $n_part_pkg,
+ map {
+ $_->{pkgpart},
+ $_->{pkg},
+ } @part_pkg
+ ), "\n";
+
+ print Client join("\n", $n_svc_acct_pop,
+ map {
+ $_->{popnum},
+ $_->{city},
+ $_->{state},
+ $_->{ac},
+ $_->{exch},
+ $_->{loc},
+ } @svc_acct_pop
+ ), "\n";
+
+ } elsif ( $command eq "new_customer" ) {
+ warn "[fs_signupd] reading customer signup...\n" if $Debug;
+ my(
+ $first, $last, $ss, $company, $address1, $address2, $city, $county,
+ $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
+ $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
+ $popnum,
+ ) = map { scalar(<Client>) } ( 1 .. 23 );
+
+ warn "[fs_signupd] sending customer data to remote server...\n" if $Debug;
+ print
+ $first, $last, $ss, $company, $address1, $address2, $city, $county,
+ $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
+ $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
+ $popnum,
+ ;
+
+ 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;
+
+ } 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;}
+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 IO::Handle;
+use Tie::RefHash;
+use Net::SSH qw(sshopen2);
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main_county;
+use FS::cust_main;
+
+use vars qw( $opt $Debug );
+
+$Debug = 0;
+
+my @payby = qw(CARD PREPAY);
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $machine = shift or die &usage;
+
+my $agentnum = shift or die &usage;
+my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage;
+my $pkgpart = $agent->pkgpart_hashref;
+
+my $refnum = shift or die &usage;
+
+#causing trouble for some folks
+#$SIG{CHLD} = sub { wait() };
+
+my($fs_signupd)="/usr/local/sbin/fs_signupd";
+
+while (1) {
+ my($reader,$writer)=(new IO::Handle, new IO::Handle);
+ $writer->autoflush(1);
+ warn "[fs_signup_server] Connecting to $machine...\n" if $Debug;
+ sshopen2($machine,$reader,$writer,$fs_signupd);
+
+ my $data;
+
+ warn "[fs_signup_server] Sending locales...\n" if $Debug;
+ my @cust_main_county = qsearch('cust_main_county', {} );
+ print $writer $data = join("\n",
+ ( scalar(@cust_main_county) || die "no tax rates (cust_main_county records)" ),
+ map {
+ $_->taxnum,
+ $_->state,
+ $_->county,
+ $_->country,
+ } @cust_main_county
+ ),"\n";
+ warn "[fs_signup_server] $data\n" if $Debug > 2;
+
+ warn "[fs_signup_server] Sending package definitions...\n" if $Debug;
+ my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } }
+ qsearch( 'part_pkg', {} );
+ print $writer $data = join("\n",
+ ( scalar(@part_pkg) || die "no usable package definitions, agent $agentnum" ),
+ map {
+ $_->pkgpart,
+ $_->pkg,
+ } @part_pkg
+ ), "\n";
+ warn "[fs_signup_server] $data\n" if $Debug > 2;
+
+ warn "[fs_signup_server] Sending POPs...\n" if $Debug;
+ my @svc_acct_pop = qsearch ('svc_acct_pop',{} );
+ print $writer $data = join("\n",
+ ( scalar(@svc_acct_pop) || die "No points of presence (svc_acct_pop records)" ),
+ map {
+ $_->popnum,
+ $_->city,
+ $_->state,
+ $_->ac,
+ $_->exch,
+ $_->loc,
+ } @svc_acct_pop
+ ), "\n";
+ warn "[fs_signup_server] $data\n" if $Debug > 2;
+
+ warn "[fs_signup_server] Entering main loop...\n" if $Debug;
+ while (1) {
+ warn "[fs_signup_server] Reading (waiting for) signup data...\n" if $Debug;
+ chop( my(
+ $first, $last, $ss, $company, $address1, $address2, $city, $county,
+ $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
+ $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
+ $popnum,
+ ) = map { scalar(<$reader>) } ( 1 .. 23 ) );
+
+ warn "[fs_signup_server] Processing signup...\n" if $Debug;
+
+ my $error = '';
+
+ #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' => $agentnum,
+ 'refnum' => $refnum,
+ '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,
+ } );
+
+ $error = "Illegal payment type" unless grep { $_ eq $payby } @payby;
+
+ my @invoicing_list = split( /\s*\,\s*/, $invoicing_list );
+
+ $error ||= $cust_main->check_invoicing_list( \@invoicing_list );
+
+ my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } )
+ or $error ||= "WARNING: unknown pkgpart $pkgpart";
+ my $svcpart = $part_pkg->svcpart unless $error;
+
+ # this should wind up in FS::cust_pkg!
+ my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } );
+ my $pkgpart_href = $agent->pkgpart_hashref;
+ $error ||= "WARNING: agent $agentnum can't purchase pkgpart $pkgpart"
+ unless $pkgpart_href->{ $pkgpart };
+
+ my $cust_pkg = new FS::cust_pkg ( {
+ #later#'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ } );
+ $error ||= $cust_pkg->check;
+
+ my $svc_acct = new FS::svc_acct ( {
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'popnum' => $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($username);
+ $svc_acct->_password($password);
+ $svc_acct->popnum($popnum);
+
+ $error ||= $svc_acct->check;
+
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash';
+ %hash = ( $cust_pkg => [ $svc_acct ] );
+ $error ||= $cust_main->insert( \%hash );
+ #if ( $cust_pkg && ! $error ) { #in this case, $cust_pkg should always
+ # #be definied, but....
+ # $cust_pkg->custnum( $cust_main->custnum );
+ # $error ||= $cust_pkg->insert;
+ # warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
+ # $svc_acct->pkgnum( $cust_pkg->pkgnum );
+ # $error ||= $svc_acct->insert;
+ # warn "WARNING: $error on pre-checked svc_acct record!" if $error;
+ #}
+
+ warn "[fs_signup_server] Sending results...\n" if $Debug;
+ print $writer $error, "\n";
+
+ $cust_main->invoicing_list( \@invoicing_list ) unless $error;
+
+ }
+ 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.9 2001-04-26 02:28:40 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",
+ "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
+AuthName Freeside
+AuthType Basic
+require valid-user
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: agent.cgi,v 1.13 1999-04-09 04:22:34 ivan Exp $
+#
+# 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
+#
+# $Log: agent.cgi,v $
+# Revision 1.13 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.12 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.11 1999/01/20 09:43:16 ivan
+# comment out future UI code (but look at it, it's neat!)
+#
+# Revision 1.10 1999/01/19 05:13:24 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.9 1999/01/18 09:41:14 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.8 1999/01/18 09:22:26 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.7 1998/12/17 05:25:16 ivan
+# fix visual and other bugs
+#
+# Revision 1.6 1998/11/23 05:29:46 ivan
+# use CGI::Carp
+#
+# Revision 1.5 1998/11/23 05:27:31 ivan
+# to eliminate warnings
+#
+# Revision 1.4 1998/11/20 08:50:36 ivan
+# s/CGI::Base/CGI.pm, visual fixes
+#
+# Revision 1.3 1998/11/08 10:11:02 ivan
+# CGI.pm
+#
+# Revision 1.2 1998/11/07 10:24:22 ivan
+# don't use depriciated FS::Bill and FS::Invoice, other miscellania
+#
+
+use strict;
+use vars qw( $ui $cgi $p $agent );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup swapuid);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar table popurl);
+use FS::agent;
+use FS::agent_type;
+
+#Begin silliness
+#
+#use FS::UI::CGI;
+#use FS::UI::agent;
+#
+#$ui = new FS::UI::agent;
+#$ui->browse;
+#exit;
+#__END__
+#End silliness
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header('Agent Listing', menubar(
+ 'Main Menu' => $p,
+ 'Agent Types' => $p. 'browse/agent_type.cgi',
+# 'Add new agent' => '../edit/agent.cgi'
+)), <<END;
+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. (unimp.)</FONT></TH>
+ <TH><FONT SIZE=-1>Prog. (unimp.)</FONT></TH>
+ </TR>
+END
+# <TH><FONT SIZE=-1>Agent #</FONT></TH>
+# <TH>Agent</TH>
+
+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="${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 new agent</I></A></TD>
+ <TD><A HREF="${p}edit/agent_type.cgi"><I>Add new agent type</I></A></TD>
+ </TR>
+ </TABLE>
+
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: agent_type.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
+#
+# 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
+#
+# $Log: agent_type.cgi,v $
+# Revision 1.8 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.7 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.6 1999/04/07 11:10:46 ivan
+# harmless typo
+#
+# Revision 1.5 1999/01/19 05:13:25 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:15 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 05:25:17 ivan
+# fix visual and other bugs
+#
+# Revision 1.2 1998/11/21 07:39:52 ivan
+# visual
+#
+
+use strict;
+use vars qw( $cgi $p $agent_type );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup swapuid);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar popurl table);
+use FS::agent_type;
+use FS::type_pkgs;
+use FS::part_pkg;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header("Agent Type Listing", menubar(
+ 'Main Menu' => $p,
+)), "Agent types define groups of packages that you can then assign to".
+ " particular agents.<BR><BR>", &table(), <<END;
+ <TR>
+ <TH COLSPAN=2>Agent Type</TH>
+ <TH COLSPAN="2">Packages</TH>
+ </TR>
+END
+
+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="${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=2><I><A HREF="${p}edit/agent_type.cgi">Add new agent type</A></I></TD></TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main_county.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $
+#
+# 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
+#
+# $Log: cust_main_county.cgi,v $
+# Revision 1.7 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.6 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.5 1999/01/19 05:13:26 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:16 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 05:25:18 ivan
+# fix visual and other bugs
+#
+# Revision 1.2 1998/11/18 09:01:34 ivan
+# i18n! i18n!
+#
+
+use strict;
+use vars qw( $cgi $p $cust_main_county );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup swapuid);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar popurl table);
+use FS::cust_main_county;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("Tax Rate Listing", menubar(
+ 'Main Menu' => $p,
+ 'Edit tax rates' => $p. "edit/cust_main_county.cgi",
+)),<<END;
+ Click on <u>expand country</u> to specify a country's tax rates by state.
+ <BR>Click on <u>expand state</u> to specify a state's tax rates by county.
+ <BR><BR>
+END
+print &table(), <<END;
+ <TR>
+ <TH><FONT SIZE=-1>Country</FONT></TH>
+ <TH><FONT SIZE=-1>State</FONT></TH>
+ <TH>County</TH>
+ <TH><FONT SIZE=-1>Tax</FONT></TH>
+ </TR>
+END
+
+foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
+ my($hashref)=$cust_main_county->hashref;
+ print <<END;
+ <TR>
+ <TD>$hashref->{country}</TD>
+END
+ print "<TD>", $hashref->{state}
+ ? $hashref->{state}
+ : qq!(ALL) <FONT SIZE=-1>!.
+ qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
+ qq!">expand country</A></FONT>!
+ , "</TD>";
+ print "<TD>";
+ if ( $hashref->{county} ) {
+ print $hashref->{county};
+ } else {
+ print "(ALL)";
+ if ( $hashref->{state} ) {
+ print qq!<FONT SIZE=-1>!.
+ qq!<A HREF="${p}edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
+ qq!">expand state</A></FONT>!;
+ }
+ }
+ print "</TD>";
+
+ print <<END;
+ <TD>$hashref->{tax}%</TD>
+ </TR>
+END
+
+}
+
+print <<END;
+ </TABLE>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw( $cgi $p );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use Date::Format;
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch); # qsearchs);
+use FS::CGI qw(header menubar table popurl);
+use FS::nas;
+use FS::port;
+use FS::session;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$p=popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), 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>";
+}
+
+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
+#!/usr/bin/perl -Tw
+#
+# $Id: part_pkg.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
+#
+# 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
+#
+# $Log: part_pkg.cgi,v $
+# Revision 1.8 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.7 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.6 1999/01/19 05:13:27 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:17 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/17 05:25:19 ivan
+# fix visual and other bugs
+#
+# Revision 1.3 1998/11/21 07:23:45 ivan
+# visual
+#
+# Revision 1.2 1998/11/21 07:00:32 ivan
+# visual
+#
+
+use strict;
+use vars qw( $cgi $p $part_pkg );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup swapuid);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar popurl table);
+use FS::part_pkg;
+use FS::pkg_svc;
+use FS::part_svc;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("Package Part Listing",menubar(
+ 'Main Menu' => $p,
+)), "One or more services are grouped together into a package and given",
+ " pricing information. Customers purchase packages, not services.<BR><BR>",
+ &table(), <<END;
+ <TABLE BORDER>
+ <TR>
+ <TH COLSPAN=2>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
+
+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="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">
+ $hashref->{pkgpart}
+ </A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_pkg.cgi?$hashref->{pkgpart}">$hashref->{pkg}</A></TD>
+ <TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
+ <TD ROWSPAN=$rowspan>$hashref->{setup}</TD>
+ <TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
+ <TD ROWSPAN=$rowspan>$hashref->{recur}</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>";
+}
+
+print <<END;
+ <TR><TD COLSPAN=2><I><A HREF="${p}edit/part_pkg.cgi">Add new package</A></I></TD></TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_referral.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $
+#
+# ivan@sisd.com 98-feb-23
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_referral.cgi,v $
+# Revision 1.9 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.8 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.7 1999/01/19 05:13:28 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:18 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/17 05:25:20 ivan
+# fix visual and other bugs
+#
+# Revision 1.4 1998/12/17 04:32:55 ivan
+# print $cgi->header
+#
+# Revision 1.3 1998/12/17 04:31:36 ivan
+# use CGI::Carp
+#
+# Revision 1.2 1998/12/17 04:26:04 ivan
+# use CGI; no relative URLs
+#
+
+use strict;
+use vars qw( $cgi $p $part_referral );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup swapuid);
+use FS::Record qw(qsearch);
+use FS::CGI qw(header menubar popurl table);
+use FS::part_referral;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("Referral Listing", menubar(
+ 'Main Menu' => $p,
+# 'Add new referral' => "../edit/part_referral.cgi",
+)), "Where a customer heard about your service. Tracked for informational purposes.<BR><BR>", &table(), <<END;
+ <TR>
+ <TH COLSPAN=2>Referral</TH>
+ </TR>
+END
+
+foreach $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 new referral</I></A></TD>
+ </TR>
+ </TABLE>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_svc.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
+#
+# 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
+#
+# $Log: part_svc.cgi,v $
+# Revision 1.11 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.10 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.9 1999/01/19 05:13:29 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.8 1999/01/18 09:41:19 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.7 1998/12/30 23:06:22 ivan
+# typo
+#
+# Revision 1.6 1998/12/30 23:03:20 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.5 1998/12/17 05:25:21 ivan
+# fix visual and other bugs
+#
+# Revision 1.4 1998/11/21 02:26:22 ivan
+# visual
+#
+# Revision 1.3 1998/11/20 23:10:57 ivan
+# visual
+#
+# Revision 1.2 1998/11/20 08:50:37 ivan
+# s/CGI::Base/CGI.pm, visual fixes
+#
+
+use strict;
+use vars qw( $cgi $p $part_svc );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch fields);
+use FS::part_svc;
+use FS::CGI qw(header menubar popurl table);
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header('Service Part Listing', menubar(
+ 'Main Menu' => $p,
+)),<<END;
+ Services are items you offer to your customers.<BR><BR>
+END
+print &table(), <<END;
+ <TR>
+ <TH COLSPAN=2>Service</TH>
+ <TH>Table</TH>
+ <TH>Field</TH>
+ <TH COLSPAN=2>Modifier</TH>
+ </TR>
+END
+
+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) || 1;
+ print <<END;
+ <TR>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_svc.cgi?$hashref->{svcpart}">
+ $hashref->{svcpart}</A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="${p}edit/part_svc.cgi?$hashref->{svcpart}"> $hashref->{svc}</A></TD>
+ <TD ROWSPAN=$rowspan>$hashref->{svcdb}</TD>
+END
+
+ my($n1)='';
+ my($row);
+ foreach $row ( @rows ) {
+ my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
+ print $n1,"<TD>$row</TD><TD>";
+ if ( $flag eq "D" ) { print "Default"; }
+ elsif ( $flag eq "F" ) { print "Fixed"; }
+ else { print "(Unknown!)"; }
+ print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD>";
+ $n1="</TR><TR>";
+ }
+print "</TR>";
+}
+
+print <<END;
+ <TR>
+ <TD COLSPAN=2><A HREF="${p}edit/part_svc.cgi"><I>Add new service</I></A></TD>
+ </TR>
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_pop.cgi,v 1.8 2000-01-28 22:56:13 ivan Exp $
+#
+# ivan@sisd.com 98-mar-8
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: svc_acct_pop.cgi,v $
+# Revision 1.8 2000-01-28 22:56:13 ivan
+# track full phone number
+#
+# Revision 1.7 1999/04/09 04:22:34 ivan
+# also table()
+#
+# Revision 1.6 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.5 1999/01/19 05:13:30 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:20 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 05:25:22 ivan
+# fix visual and other bugs
+#
+# Revision 1.2 1998/12/17 04:36:59 ivan
+# use CGI;, use CGI::Carp, visual changes, relative URLs
+#
+
+use strict;
+use vars qw( $cgi $p $svc_acct_pop );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup swapuid);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar table popurl);
+use FS::svc_acct_pop;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header('POP 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 $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="${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 POP</I></A></TD>
+ </TR>
+ </TABLE>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
--- /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 http://your_host/freeside/. Replace
+ "your_host" with the name or network address of your web server.
+
+ <li>Once in the Freeside web interface, you must first create a
+ service. An example of a service would be a dial-up account or a
+ hosted virtual domain.
+
+ <li>After you create your first service or services, you must then
+ create a package of that service or services which you will sell to
+ your customer. To allow flexibility in changing your service
+ offerings, Freeside requires that you bundle your services into a
+ package before customers may purchase them. For instance, you could
+ create a leased line package which would consist of a one-time
+ charge for the customer premise equipment, the monthly service fee
+ for the leased line, a backup dial-up account, and a support
+ contract. You could also create a leased line package which omits
+ the support contract simply by adding a new package that does not
+ include the support contract.
+
+ <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.
+
+ <li>After creating a new agent type, you must create an agent, and
+ assign the the agent type you just created to it.
+
+ <li>If the service you created was of type svc_acct, you may have to
+ create a POP from the main menu before you can create your first new
+ customer.
+
+ <li>If you are using Freeside to keep track of sales taxes, you must
+ define tax information for your locale by clicking on the "View/Edit
+ locales and tax rates" link on the Freeside main menu.
+
+ <li>Finally, set up at least one referral by clicking on the
+ "View/Edit referrals" link in the Freeside main menu. Referrals
+ will help you keep track of how effective your advertising is, by
+ helping you keep track of where customers heard of your service
+ offerings. You must create at least one referral. If you do not wish to
+ use the referral functionality, simply create a single referral only.
+
+ <li>You should now be ready to sign up your first customer by
+ clicking on the "New Customer" link at the top of the Freeside main
+ menu.
+</ul>
+</body>
+</html>
--- /dev/null
+<head>
+ <title>Billing</title>
+</head>
+<body>
+ <h1>Billing</h1>
+ <ul>
+ <li>To enable billing, you <b>must</b> create an <a href="config.html#invoice_template">invoice_template</a> configuration file. An example file is available in the <i>conf/</i> directory of the distribution. You also need to create an <a href="config.html#lpr">lpr</a> configuration file to enable postal invoices.
+ <ul>
+ <li>Optional: Invoice template customization
+ <ul>
+ <li>See the <a href="http://search.cpan.org/doc/MJD/Text-Template-1.23/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.
+ <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>
+ </ul>
+ <li>You can bill individual customers by clicking on the <i>Bill now</i> link on the main customer view.
+ <li> The <b>freeside-bill</b> script can be run daily to bill all customers. Usage:<pre>bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ] <i>user</i></pre>
+ <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.
+ <li>-d: Pretend it is <i>date</i> (parsed by <a href="http://search.cpan.org/doc/GBARR/TimeDate-1.09/lib/Date/Parse.pm">Date::Parse</a>)
+ <li>-b: N/A
+ </ul>
+ <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.<br><br>
+ <li>The <b>freeside-print-batch</b> script can print or email pending credit card batches for manual entry. Usage: freeside-print-batch [-v] [-p] [-e] [-a] [-d] <i>user</i>
+ <ul>
+ <li>-v: Verbose - Prints records to STDOUT.
+ <li>-p: Print to printer lpr as found in the conf directory.
+ <li>-e: Email output to user found in the Conf email file.
+ <li>-a: Automatically pays all records in cust_pay_batch. Use -d with this option usually.
+ <li>-d: Delete - Pays account and deletes record from cust_pay_batch.
+ </ul>
+ </ul>
+ </ul>
+</body>
--- /dev/null
+<head>
+ <title>Configuration files</title>
+</head>
+<body>
+ <h1>Configuration files</h1>
+<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.15/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.15/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>
+</ul>
+All further configuration files and directories are located in
+<tt>/usr/local/etc/freeside/conf.<i>datasource</i></tt>, for example,
+<tt>/usr/local/etc/freeside/conf.DBI:Pg:host=localhost;dbname=freeside</tt> (remember to backslash-escape the ; character when creating directories in the shell: <tt>mkdir /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=freeside</tt>).
+<ul>
+ <li><a name="address">address</a> - This configuration file is no longer used. See <a href="#invoice_template">invoice_template</a> instead.
+ <li><a name="apacheroot">apacheroot</a> - The directory containing Apache virtual hosts
+ <li><a name="apachemachine">apachemachine</a> - 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.
+ <li><a name="apachemachines">apachemachines</a> - 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.
+ <li><a name="autocapnames">autocapnames</a> - The presence of this file will cause Freeside to use Javascript in /htdocs/edit/cust_main.cgi to automatically capitalize the first and last names of customers.
+ <li><a name="bindprimary">bindprimary</a> - Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named
+ <li><a name="bindsecondaries">bindsecondaries</a> - Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf
+ <li><a name="bsdshellmachines">bsdshellmachines</a> - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'.
+ <li><a name="countrydefault">countrydefault</a> - Default two-letter country code (if not supplied, the default is `US')
+ <li><a name="cybercash2">cybercash2</a> - <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><a name="deletecustomers">deletecustomers</a> - The existance of this file will 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.
+ <li><a name="domain">domain</a> - Your domain name.
+ <li><a name="editreferrals">editreferrals</a> - The existance of this file will allow you to change the referral of existing customers.
+ <li><a name="erpcdmachines">erpcdmachines</a> - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
+ <li><a name="hidecancelledpackages">hidecancelledpackages</a> - The existance of this file will prevent cancelled packages from showing up in listings (though they will still be in the database)
+ <li><a name="hidecancelledcustomers">hidecancelledcustomers</a> - The existance of this file will prevent customers with only cancelled packages from showing up in listings (though they will still be in the database)
+ <li><a name="home">home</a> - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash.
+ <li><a name="icradiusmachines">icradiusmachines</a> - Your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines, one per line. The existance of this file (even if empty) turns on radcheck table creation (in the freeside database - the radcheck table needs to be created manually). Machines listed in this file will have the radcheck table exported to them. Each line of this file 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>". Note that to use ICRADIUS export you need to be using MySQL.
+ <li><a name="icradius_mysqldest">icradius_mysqldest</a> - Destination directory for the MySQL databases, on the ICRADIUS machines. Defaults to "/usr/local/var/".
+ <li><a name="icradius_mysqlsource">icradius_mysqlsource</a> - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".
+ <li><a name="icradius_secrets">icradius_secrets</a> - Optionally specifies a MySQL database for ICRADIUS export, if you're not running MySQL for your Freeside database. The database should be on the Freeside machine and store data in the <a href="#icradius_mysqlsource">icradius_mysqlsource</a> directory. Three lines: DBI data source, username and password. This file should not be world readable.
+ <li><a name="invoice_from">invoice_from</a> - Return address on email invoices.
+ <li><a name="invoice_template">invoice_template</a> - Required template file for invoices. See the <a href="billing.html">section on billing</a> for details.
+ <li><a name="lpr">lpr</a> - Print command for paper invoices, for example `lpr -h'.
+ <li><a name="maildisablecatchall">maildisablecatchall</a> - The existance of this file will disable the requirement that each virtual domain have a catch-all mailbox.
+ <li><a name="money_char">money_char</a> - Currency symbol - defaults to `$'.
+ <li><a name="mxmachines">mxmachines</a> - MX entries for new domains, weight and machine, one per line, with trailing `.'
+ <li><a name="nsmachines">nsmachines</a> - NS nameservers for new domains, one per line, with trailing `.'
+ <li><a name="nismachines">nismachines</a> - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'.
+ <li><a name="passwordmin">passwordmin</a> - Minimum password length (default 6);
+ <li><a name="qmailmachines">qmailmachines</a> - 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><a name="radiusmachines">radiusmachines</a> - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'.
+ <li><a name="referraldefault">referraldefault</a> - Default referral, specified by refnum.
+ <li><a name="registries">registries</a> - 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><a name="sendmailconfigpath">sendmailconfigpath</a> - Sendmail configuration file path - defaults to `/etc'. Many newer distributions use `/etc/mail'.
+ <li><a name="sendmailmachines">sendmailmachines</a> - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'.
+ <li><a name="sendmailrestart">sendmailrestart</a> - If defined, the command which is run on sendmail machines after files are copied.
+ <li><a name="session-start">session-start</a> - 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.
+ <li><a name="session-stop">session-stop</a> - 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.
+ <li><a name="shellmachine">shellmachine</a> - 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>shellmachine-useradd - The command(s) to run on shellmachine when an account is created. 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>shellmachine-userdel - The command(s) to run on shellmachine when an account is deleted. 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>shellmachine-usermod - The command(s) to run on shellmachine when an account is modified. 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>.
+ <li><a name="shellmachines">shellmachines</a> - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files.
+ <li><a name="shells">shells</a> - 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><a name="showpasswords">showpasswords</a> - The existance of this file will allow unencrypted user passwords to be displayed.
+ <li><a name="smtpmachine">smtpmachine</a> - SMTP relay for Freeside's outgoing mail.
+ <li><a name="soadefaultttl">soadefaultttl</a> - SOA default TTL for new domains.
+ <li><a name="soaemail">soaemail</a> - SOA email for new domains, in BIND form (`.' instead of `@'), with trailing `.'
+ <li><a name="soaexpire">soaexpire</a> - SOA expire for new domains
+ <li><a name="soamachine">soamachine</a> - SOA machine for new domains, with trailing `.'
+ <li><a name="soarefresh">soarefresh</a> - SOA refresh for new domains
+ <li><a name="soaretry">soaretry</a> - SOA retry for new domains
+ <li><a name="statedefault">statedefault</a> - Default state or province (if not supplied, the default is `CA')
+ <li><a name="textradiusprepend">textradiusprepend</a> - The contents of this file will be prepended to the first line of a user's RADIUS entry in text exports. If necessary, usually `Auth-Type = Local, '.
+ <li><a name="usernamemin">usernamemin</a> - Minimum username length (default 2);
+ <li><a name="usernamemax">usernamemax</a> - Maximum username length (default is the size of the SQL column, probably specified when fs-setup was run)
+ <li><a name="usernamemax">username-letter</a> - The existance of this file will turn on the requirement that usernames contain at least one letter.
+ <li><a name="usernamemax">username-letterfirst</a> - The existance of this file will turn on the requirement that usernames start with a letter.
+</ul>
+</body>
+
--- /dev/null
+<head>
+ <title>File exporting</title>
+</head>
+<body>
+ <h1>File exporting</h1>
+ <ul>
+ <li>bin/svc_acct.export will create UNIX <b>passwd</b>, <b>shadow</b> and <b>master.passwd</b> files, ERPCD <b>acp_passwd</b> and <b>acp_dialup</b> files and a RADIUS <b>users</b> file in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Some RADIUS servers (such as <a href="http://www.open.com.au/radiator/">Radiator</a> and <a href="ftp://ftp.cheapnet.net/pub/icradius/">ICRADIUS</a>) will authenticate directly out of an SQL database. In these cases,
+it is reccommended that you replicate the data to an external RADIUS machine rather than running the RADIUS server on your Freeside machine. Using the appropriate <a href="config.html">configuration files</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 - Local radcheck and radreply tables will be created. If any machines are specified, the remote MySQL database will be locked and the radcheck table will be copied to the those machines. You may also need to set the <a href="config.html#icradius_mysqlsource">icradius_mysqlsource</a> and/or <a href="config.html#icradius_mysqldest">icradius_mysqldest</a> configuration files. Currently you need to be running MySQL for your Freeside database to use this feature.
+ </ul>
+ <li>site_perl/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.html#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.html#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.html#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>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a> <b>rcpthosts</b>, <b>recipientmap</b> and <b>virtualdomains</b> files and <a href="http://www.sendmail.org">Sendmail</a> <b>virtusertable</b> and <b>sendmail.cw</b> files in the <b>/usr/local/etc/freeside/export.<i>datasrc</i></b> directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattemded:
+ <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.html#sendmailrestart">sendmailrestart</a> configuration file is executed. (The path can be changed from the default <b>/etc</b> with the <a href="config.html#sendmailconfigpath">sendmailconfigpath</a> configuration file.)
+ </ul>
+ <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user <b>.qmail-</b> files can be updated.
+ <ul>
+ <li>The command <b>[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }</b> is run.
+ </ul>
+ </ul>
+ <br><a name=ssh>Unattended remote login</a> - Freeside can login to remote machines unattended using SSH. This can pose a security risk if not configured correctly, and will allow an intruder who breaks into your freeside machine full access to your remote machines. <b>Do not use this feature unless you understand what you are doing!</b>
+ <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 bgcolor="#ffffff">
+ <h1>Documentation</h1>
+<img src="overview.png">
+<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.4</a>
+ <li><a href="upgrade3.html">Upgrading from 1.1.x to 1.2.x</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="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="trouble.html">Troubleshooting</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 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="http://www.openssh.com//">SSH</a>
+ <li><a href="http://www.perl.com/">Perl</a> Don't enable experimental features like threads or the PerlIO abstraction layer.
+ <li>A <b>transactional</b> database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>. <a href="http://www.postgresql.org/">PostgreSQL</a> is recommended. (see the <a href="postgresql.html">PostgreSQL notes</a>) <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>.
+ <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=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>
+ <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>
+ </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.mysql.com/Manual_chapter/manual_Privilege_system.html#Privilege_system">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>
+ <li> with <a href="http://postgresql.readysetnet.com/users-lounge/docs/7.1/postgres/user-manag.html#DATABASE-USERS">PostgreSQL</a>
+ </ul>
+ <li>Add the freeside database to your database engine. (with <a href="http://www.mysql.com/Manual_chapter/manual_Reference.html#CREATE_DATABASE">MySQL</a>) (with <a href="http://postgresql.readysetnet.com/users-lounge/docs/7.1/postgres/managing-databases.html#MANAGE-AG-CREATEDB">PostgreSQL</a>)
+ <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>
+ <li>Build and install the Perl libraries:
+ <pre>
+$ cd FS/
+$ perl Makefile.PL
+$ make
+$ su
+# make install UNINST=1</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://httpd.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. The web interface needs to run as the freeside user - there are several ways to do this.
+ <ul>
+ <li>Use Perl's setuid emulation: see the <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">Security Bugs</a> section of the <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html">perlsec</a> manpage.
+<pre>cd /usr/local/apache/htdocs/freeside
+chown -R freeside .
+chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
+ <li>Use Apache's <a href="http://www.apache.org/docs/suexec.html">suEXEC</a>.
+<pre>cd /usr/local/apache/htdocs/freeside
+chown -R freeside .
+chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
+ <li>Use <a href="http://perl.apache.org/">mod_perl</a>. You should run a separate iteration of Apache[-SSL] as the freeside user. (Warning: The redirect method of CGI.pm 2.36 [as distributed with Perl 5.004_04] is broken under mod_perl. Downlaod the current version from <a href="http://www.perl.com/CPAN/modules/by-module/CGI">CPAN</a>. Apache 1.3.6 is also highly recommended because of signal handling problems in earlier versions.)
+<pre>cd /usr/local/apache/htdocs/freeside
+chown -R root .
+chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
+ </ul>
+<li>Create the necessary <a href="config.html">configuration files</a>.
+<li>Create the `/usr/local/etc/freeside/counters.<i>datasrc</i>', and
+ `/usr/local/etc/freeside/export.<i>datasrc</i>' directories for each <i>datasrc</i> (owned by the freeside user).
+ <li>As the freeside user, run bin/fs-setup to create the database tables.
+ <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>
+<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="../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
+<HTML>
+<HEAD>
+<TITLE>FS - Freeside Perl modules</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <UL>
+
+ <LI><A HREF="#utility classes">Utility classes</A></LI>
+ <LI><A HREF="#database record classes">Database record classes</A></LI>
+ <LI><A HREF="#user interface classes (under development; not yet usable)">User Interface classes (under development; not yet usable)</A></LI>
+ <LI><A HREF="#notes">Notes</A></LI>
+ </UL>
+
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#support">SUPPORT</A></LI>
+ <LI><A HREF="#author">AUTHOR</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS - Freeside Perl modules</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<P>FS is the unofficial (i.e. non-CPAN) prefix for the Perl module portion of the
+Freeside ISP billing software. This includes:</P>
+<P>
+<H2><A NAME="utility classes">Utility classes</A></H2>
+<P><A HREF="././FS/Conf.html">the FS::Conf manpage</A> - Freeside configuration values</P>
+<P><A HREF="././FS/UID.html">the FS::UID manpage</A> - User class (not yet OO)</P>
+<P><A HREF="././FS/CGI.html">the FS::CGI manpage</A> - Non OO-subroutines for the web interface. This is
+depriciated. Future development will be focused on the FS::UI user-interface
+classes (see below).</P>
+<P>
+<H2><A NAME="database record classes">Database record classes</A></H2>
+<P><A HREF="././FS/Record.html">the FS::Record manpage</A> - Database record base class</P>
+<P><A HREF="././FS/svc_acct_pop.html">the FS::svc_acct_pop manpage</A> - POP (Point of Presence, not Post
+Office Protocol) class</P>
+<P><A HREF="././FS/part_referral.html">the FS::part_referral manpage</A> - Referral class</P>
+<P><A HREF="././FS/cust_main_county.html">the FS::cust_main_county manpage</A> - Locale (tax rate) class</P>
+<P><A HREF="././FS/svc_Common.html">the FS::svc_Common manpage</A> - Service base class</P>
+<P><A HREF="././FS/svc_acct.html">the FS::svc_acct manpage</A> - Account (shell, RADIUS, POP3) class</P>
+<P><A HREF="././FS/svc_domain.html">the FS::svc_domain manpage</A> - Domain class</P>
+<P><A HREF="././FS/domain_record.html">the FS::domain_record manpage</A> - DNS zone entries</P>
+<P><A HREF="././FS/svc_acct_sm.html">the FS::svc_acct_sm manpage</A> - Vitual mail alias class</P>
+<P><A HREF="././FS/svc_www.html">the FS::svc_www manpage</A> - Web virtual host class.</P>
+<P><A HREF="././FS/part_svc.html">the FS::part_svc manpage</A> - Service definition class</P>
+<P><A HREF="././FS/part_pkg.html">the FS::part_pkg manpage</A> - Package (billing item) definition class</P>
+<P><A HREF="././FS/pkg_svc.html">the FS::pkg_svc manpage</A> - Class linking package (billing item)
+definitions (see <A HREF="././FS/part_pkg.html">the FS::part_pkg manpage</A>) with service definitions
+(see <A HREF="././FS/part_svc.html">the FS::part_svc manpage</A>)</P>
+<P><A HREF="././FS/agent.html">the FS::agent manpage</A> - Agent (reseller) class</P>
+<P><A HREF="././FS/agent_type.html">the FS::agent_type manpage</A> - Agent type class</P>
+<P><A HREF="././FS/type_pkgs.html">the FS::type_pkgs manpage</A> - Class linking agent types (see
+<A HREF="././FS/agent_type.html">the FS::agent_type manpage</A>) with package (billing item) definitions
+(see <A HREF="././FS/part_pkg.html">the FS::part_pkg manpage</A>)</P>
+<P><A HREF="././FS/cust_svc.html">the FS::cust_svc manpage</A> - Service class</P>
+<P><A HREF="././FS/cust_pkg.html">the FS::cust_pkg manpage</A> - Package (billing item) class</P>
+<P><A HREF="././FS/cust_main.html">the FS::cust_main manpage</A> - Customer class</P>
+<P><A HREF="././FS/cust_main_invoice.html">the FS::cust_main_invoice manpage</A> - Invoice destination
+class</P>
+<P><A HREF="././FS/cust_bill.html">the FS::cust_bill manpage</A> - Invoice class</P>
+<P><A HREF="././FS/cust_bill_pkg.html">the FS::cust_bill_pkg manpage</A> - Invoice line item class</P>
+<P><A HREF="././FS/cust_pay.html">the FS::cust_pay manpage</A> - Payment class</P>
+<P><A HREF="././FS/cust_credit.html">the FS::cust_credit manpage</A> - Credit class</P>
+<P><A HREF="././FS/cust_refund.html">the FS::cust_refund manpage</A> - Refund class</P>
+<P><A HREF="././FS/cust_pay_batch.html">the FS::cust_pay_batch manpage</A> - Credit card transaction queue class</P>
+<P><A HREF="././FS/prepay_credit.html">the FS::prepay_credit manpage</A> - Prepaid ``calling card'' credit class.</P>
+<P><A HREF="././FS/nas.html">the FS::nas manpage</A> - Network Access Server class</P>
+<P><A HREF="././FS/port.html">the FS::port manpage</A> - NAS port class</P>
+<P><A HREF="././FS/session.html">the FS::session manpage</A> - User login session class</P>
+<P>
+<H2><A NAME="user interface classes (under development; not yet usable)">User Interface classes (under development; not yet usable)</A></H2>
+<P><A HREF="././FS/UI/Base.html">the FS::UI::Base manpage</A> - User-interface base class</P>
+<P><A HREF="././FS/UI/Gtk.html">the FS::UI::Gtk manpage</A> - Gtk user-interface class</P>
+<P><A HREF="././FS/UI/CGI.html">the FS::UI::CGI manpage</A> - CGI (HTML) user-interface class</P>
+<P><A HREF="././FS/UI/agent.html">the FS::UI::agent manpage</A> - agent table user-interface class</P>
+<P>
+<H2><A NAME="notes">Notes</A></H2>
+<P>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.''</P>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>Freeside is a billing and administration package for Internet Service
+Providers.</P>
+<P>The Freeside home page is at <http://www.sisd.com/freeside>.</P>
+<P>The main documentation is in htdocs/docs.</P>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: FS.html,v 1.3 2001-04-23 12:40:30 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="support">SUPPORT</A></H1>
+<P>A mailing list for users and developers is available. Send a blank message to
+<<A HREF="mailto:ivan-freeside-subscribe@sisd.com">ivan-freeside-subscribe@sisd.com</A>> to subscribe.</P>
+<P>Commercial support is available; see
+<http://www.sisd.com/freeside/commercial.html>.</P>
+<P>
+<HR>
+<H1><A NAME="author">AUTHOR</A></H1>
+<P>Primarily Ivan Kohler <<A HREF="mailto:ivan@sisd.com">ivan@sisd.com</A>>, with help from many kind folks.</P>
+<P>See the CREDITS file in the Freeside distribution for a (hopefully) complete
+list and the individal files for details.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P>perl(1), main Freeside documentation in htdocs/docs/</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The version number of the FS Perl extension differs from the version of the
+Freeside distribution, which are both different from the CVS version tag for
+each file, which appears under the VERSION heading.</P>
+<P>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...</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::Bill - Legacy stub</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::Bill - Legacy stub
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+The functionality of FS::Bill has been integrated into FS::cust_main.
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::CGI - Subroutines for the web interface</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#subroutines">SUBROUTINES</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::CGI - Subroutines for the web interface</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::CGI qw(header menubar idiot eidiot popurl);</PRE>
+<PRE>
+ print header( 'Title', '' );
+ print header( 'Title', menubar('item', 'URL', ... ) );</PRE>
+<PRE>
+ idiot "error message";
+ eidiot "error message";</PRE>
+<PRE>
+ $url = popurl; #returns current url
+ $url = popurl(3); #three levels up</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>Provides a few common subroutines for the web interface.</P>
+<P>
+<HR>
+<H1><A NAME="subroutines">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_header">header TITLE, MENUBAR</A></STRONG><BR>
+<DD>
+Returns an HTML header.
+<P></P>
+<DT><STRONG><A NAME="item_menubar_ITEM%2C_URL%2C_%2E%2E%2E">menubar ITEM, URL, ...</A></STRONG><BR>
+<DD>
+Returns an HTML menubar.
+<P></P>
+<DT><STRONG><A NAME="item_idiot">idiot ERROR</A></STRONG><BR>
+<DD>
+This is depriciated. Don't use it.
+<P>Sends headers and an HTML error message.</P>
+<P></P>
+<DT><STRONG><A NAME="item_eidiot">eidiot ERROR</A></STRONG><BR>
+<DD>
+This is depriciated. Don't use it.
+<P>Sends headers and an HTML error message, then exits.</P>
+<P></P>
+<DT><STRONG><A NAME="item_popurl">popurl LEVEL</A></STRONG><BR>
+<DD>
+Returns current URL with LEVEL levels of path removed from the end (default 0).
+<P></P>
+<DT><STRONG><A NAME="item_table">table</A></STRONG><BR>
+<DD>
+Returns HTML tag for beginning a table.
+<P></P>
+<DT><STRONG><A NAME="item_itable">itable</A></STRONG><BR>
+<DD>
+Returns HTML tag for beginning an (invisible) table.
+<P></P>
+<DT><STRONG><A NAME="item_ntable">ntable</A></STRONG><BR>
+<DD>
+This is getting silly.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Not OO.</P>
+<P>Not complete.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/CGI.html">the CGI manpage</A>, <A HREF="../CGI/Base.html">the CGI::Base manpage</A></P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>./FS/FS/CGIwrapper.pm</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+<!-- INDEX END -->
+
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::Conf - Read access to Freeside configuration values</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::Conf - Read access to Freeside configuration values</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::Conf;</PRE>
+<PRE>
+ $conf = new FS::Conf "/config/directory";</PRE>
+<PRE>
+ $FS::Conf::default_dir = "/config/directory";
+ $conf = new FS::Conf;</PRE>
+<PRE>
+ $dir = $conf->dir;</PRE>
+<PRE>
+ $value = $conf->config('key');
+ @list = $conf->config('key');
+ $bool = $conf->exists('key');</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>Read access to Freeside configuration values. Keys currently map to filenames,
+but this may change in the future.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new_%5B_DIRECTORY_%5D">new [ DIRECTORY ]</A></STRONG><BR>
+<DD>
+Create a new configuration object. A directory arguement is required if
+$FS::Conf::default_dir has not been set.
+<P></P>
+<DT><STRONG><A NAME="item_dir">dir</A></STRONG><BR>
+<DD>
+Returns the directory.
+<P></P>
+<DT><STRONG><A NAME="item_config">config</A></STRONG><BR>
+<DD>
+Returns the configuration value or values (depending on context) for key.
+<P></P>
+<DT><STRONG><A NAME="item_exists">exists</A></STRONG><BR>
+<DD>
+Returns true if the specified key exists, even if the corresponding value
+is undefined.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Write access (with locking) should be implemented.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P>config.html from the base documentation contains a list of configuration files.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::Invoice - Legacy stub</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::Invoice - Legacy stub
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+The functionality of FS::Invoice has been integrated in FS::cust_bill.
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::Record - Database record objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#constructors">CONSTRUCTORS</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#subroutines">SUBROUTINES</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::Record - Database record objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::Record;
+ use FS::Record qw(dbh fields qsearch qsearchs dbdef);</PRE>
+<PRE>
+ $record = new FS::Record 'table', \%hash;
+ $record = new FS::Record 'table', { 'column' => 'value', ... };</PRE>
+<PRE>
+ $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', ... };</PRE>
+<PRE>
+ $table = $record->table;
+ $dbdef_table = $record->dbdef_table;</PRE>
+<PRE>
+ $value = $record->get('column');
+ $value = $record->getfield('column');
+ $value = $record->column;</PRE>
+<PRE>
+ $record->set( 'column' => 'value' );
+ $record->setfield( 'column' => 'value' );
+ $record->column('value');</PRE>
+<PRE>
+ %hash = $record->hash;</PRE>
+<PRE>
+ $hashref = $record->hashref;</PRE>
+<PRE>
+ $error = $record->insert;
+ #$error = $record->add; #depriciated</PRE>
+<PRE>
+ $error = $record->delete;
+ #$error = $record->del; #depriciated</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);
+ #$error = $new_record->rep($old_record); #depriciated</PRE>
+<PRE>
+ $value = $record->unique('column');</PRE>
+<PRE>
+ $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');</PRE>
+<PRE>
+ $dbdef = reload_dbdef;
+ $dbdef = reload_dbdef "/non/standard/filename";
+ $dbdef = dbdef;</PRE>
+<PRE>
+ $quoted_value = _quote($value,'table','field');</PRE>
+<PRE>
+ #depriciated
+ $fields = hfields('table');
+ if ( $fields->{Field} ) { # etc.</PRE>
+<PRE>
+ @fields = fields 'table'; #as a subroutine
+ @fields = $record->fields; #as a method call</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>(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.</P>
+<P>
+<HR>
+<H1><A NAME="constructors">CONSTRUCTORS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new_%5B_TABLE%2C_%5D_HASHREF">new [ TABLE, ] HASHREF</A></STRONG><BR>
+<DD>
+Creates a new record. It doesn't store it in the database, though. See
+<A HREF="#insert">insert</A> for that.
+<P>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 <EM>hash</EM>
+method.</P>
+<P>TABLE can only be omitted when a dervived class overrides the table method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_qsearch_TABLE%2C_HASHREF%2C_SELECT%2C_EXTRA_SQL">qsearch TABLE, HASHREF, SELECT, EXTRA_SQL</A></STRONG><BR>
+<DD>
+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.
+<P>###oops, argh, FS::Record::new only lets us create database fields.
+#Normal behaviour if SELECT is not specified is `*', as in
+#<CODE>SELECT * FROM table WHERE ...</CODE>. 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.</P>
+<P></P>
+<DT><STRONG><A NAME="item_qsearchs">qsearchs TABLE, HASHREF</A></STRONG><BR>
+<DD>
+Same as qsearch, except that if more than one record matches, it <STRONG>carp</STRONG>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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_table">table</A></STRONG><BR>
+<DD>
+Returns the table name.
+<P></P>
+<DT><STRONG><A NAME="item_dbdef_table">dbdef_table</A></STRONG><BR>
+<DD>
+Returns the FS::dbdef_table object for the table.
+<P></P>
+<DT><STRONG><A NAME="item_get%2C_getfield_COLUMN">get, getfield COLUMN</A></STRONG><BR>
+<DD>
+Returns the value of the column/field/key COLUMN.
+<P></P>
+<DT><STRONG><A NAME="item_set%2C_setfield_COLUMN%2C_VALUE">set, setfield COLUMN, VALUE</A></STRONG><BR>
+<DD>
+Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE.
+<P></P>
+<DT><STRONG><A NAME="item_AUTLOADED_METHODS">AUTLOADED METHODS</A></STRONG><BR>
+<DD>
+$record->column is a synonym for $record->get('column');
+<P>$record-><CODE>column('value')</CODE> is a synonym for $record->set('column','value');</P>
+<P></P>
+<DT><STRONG><A NAME="item_hash">hash</A></STRONG><BR>
+<DD>
+Returns a list of the column/value pairs, usually for assigning to a new hash.
+<P>To make a distinct duplicate of an FS::Record object, you can do:</P>
+<PRE>
+ $new = new FS::Record ( $old->table, { $old->hash } );</PRE>
+<P></P>
+<DT><STRONG><A NAME="item_hashref">hashref</A></STRONG><BR>
+<DD>
+Returns a reference to the column/value hash.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Inserts this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_add">add</A></STRONG><BR>
+<DD>
+Depriciated (use insert instead).
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_del">del</A></STRONG><BR>
+<DD>
+Depriciated (use delete instead).
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replace the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_rep">rep</A></STRONG><BR>
+<DD>
+Depriciated (use replace instead).
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+Not yet implemented, croaks. Derived classes should provide a check method.
+<P></P>
+<DT><STRONG><A NAME="item_unique">unique COLUMN</A></STRONG><BR>
+<DD>
+Replaces COLUMN in record with a unique number. Called by the <STRONG>add</STRONG> method
+on primary keys and single-field unique columns (see <A HREF="../DBIx/DBSchema/Table.html">the DBIx::DBSchema::Table manpage</A>).
+Returns the new value.
+<P></P>
+<DT><STRONG><A NAME="item_ut_float_COLUMN">ut_float COLUMN</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_ut_number_COLUMN">ut_number COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint simple numeric data (whole numbers). May not be null. If there
+is an error, returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_ut_numbern_COLUMN">ut_numbern COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint simple numeric data (whole numbers). May be null. If there is
+an error, returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_ut_money_COLUMN">ut_money COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint monetary numbers. May be negative. Set to 0 if null. If there
+is an error, returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_ut_text_COLUMN">ut_text COLUMN</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_ut_textn_COLUMN">ut_textn COLUMN</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_ut_alpha_COLUMN">ut_alpha COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint alphanumeric strings (no spaces). May not be null. If there is
+an error, returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG>ut_alpha COLUMN</STRONG><BR>
+<DD>
+Check/untaint alphanumeric strings (no spaces). May be null. If there is an
+error, returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_ut_phonen_COLUMN_%5B_COUNTRY_%5D">ut_phonen COLUMN [ COUNTRY ]</A></STRONG><BR>
+<DD>
+Check/untaint phone numbers. May be null. If there is an error, returns
+the error, otherwise returns false.
+<P>Takes an optional two-letter ISO country code; without it or with unsupported
+countries, ut_phonen simply calls ut_alphan.</P>
+<P></P>
+<DT><STRONG><A NAME="item_ut_ip_COLUMN">ut_ip COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint ip addresses. IPv4 only for now.
+<P></P>
+<DT><STRONG><A NAME="item_ut_ipn_COLUMN">ut_ipn COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint ip addresses. IPv4 only for now. May be null.
+<P></P>
+<DT><STRONG><A NAME="item_ut_domain_COLUMN">ut_domain COLUMN</A></STRONG><BR>
+<DD>
+Check/untaint host and domain names.
+<P></P>
+<DT><STRONG><A NAME="item_ut_anything_COLUMN">ut_anything COLUMN</A></STRONG><BR>
+<DD>
+Untaints arbitrary data. Be careful.
+<P></P>
+<DT><STRONG><A NAME="item_fields_%5B_TABLE_%5D">fields [ TABLE ]</A></STRONG><BR>
+<DD>
+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 <A HREF="../DBIx/DBSchema/Table.html">the DBIx::DBSchema::Table manpage</A>).
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="subroutines">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_reload_dbdef"><CODE>reload_dbdef([FILENAME])</CODE></A></STRONG><BR>
+<DD>
+Load a database definition (see <A HREF="../DBIx/DBSchema.html">the DBIx::DBSchema manpage</A>), optionally from a
+non-default filename. This command is executed at startup unless
+<EM>$FS::Record::setup_hack</EM> is true. Returns a DBIx::DBSchema object.
+<P></P>
+<DT><STRONG><A NAME="item_dbdef">dbdef</A></STRONG><BR>
+<DD>
+Returns the current database definition. See <A HREF="../FS/dbdef.html">the FS::dbdef manpage</A>.
+<P></P>
+<DT><STRONG><A NAME="item__quote_VALUE%2C_TABLE%2C_COLUMN">_quote VALUE, TABLE, COLUMN</A></STRONG><BR>
+<DD>
+This is an internal function used to construct SQL statements. It returns
+VALUE DBI-quoted (see <EM>DBI/``quote''</EM>) unless VALUE is a number and the column
+type (see <A HREF="../FS/dbdef_column.html">the FS::dbdef_column manpage</A>) does not end in `char' or `binary'.
+<P></P>
+<DT><STRONG><A NAME="item_hfields">hfields TABLE</A></STRONG><BR>
+<DD>
+This is depriciated. Don't use it.
+<P>It returns a hash-type list with the fields of this record's table set true.</P>
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: Record.html,v 1.3 2001-04-23 12:40:30 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>This module should probably be renamed, since much of the functionality is
+of general use. It is not completely unlike Adapter::DBI (see below).</P>
+<P>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.)</P>
+<P>The whole fields / hfields mess should be removed.</P>
+<P>The various WHERE clauses should be subroutined.</P>
+<P>table string should be depriciated in favor of FS::dbdef_table.</P>
+<P>No doubt we could benefit from a Tied hash. Documenting how exists / defined
+true maps to the database (and WHERE clauses) would also help.</P>
+<P>The ut_ methods should ask the dbdef for a default length.</P>
+<P>ut_sqltype (like ut_varchar) should all be defined</P>
+<P>A fallback check method should be provided which uses the dbdef.</P>
+<P>The ut_money method assumes money has two decimal digits.</P>
+<P>The Pg money kludge in the new method only strips `$'.</P>
+<P>The ut_phonen method assumes US-style phone numbers.</P>
+<P>The _quote function should probably use ut_float instead of a regex.</P>
+<P>All the subroutines probably should be methods, here or elsewhere.</P>
+<P>Probably should borrow/use some dbdef methods where appropriate (like sub
+fields)</P>
+<P>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)</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF="../DBIx/DBSchema.html">the DBIx::DBSchema manpage</A>, <A HREF=".././FS/UID.html">the FS::UID manpage</A>, <EM>DBI</EM></P>
+<P>Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::SSH - Subroutines to call ssh and scp</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#SUBROUTINES">SUBROUTINES</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::SSH - Subroutines to call ssh and scp
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::SSH qw(ssh scp issh iscp sshopen2 sshopen3);
+</PRE>
+<P>
+<PRE> ssh($host, $command);
+</PRE>
+<P>
+<PRE> issh($host, $command);
+</PRE>
+<P>
+<PRE> scp($source, $destination);
+</PRE>
+<P>
+<PRE> iscp($source, $destination);
+</PRE>
+<P>
+<PRE> sshopen2($host, $reader, $writer, $command);
+</PRE>
+<P>
+<PRE> sshopen3($host, $reader, $writer, $error, $command);
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+<PRE> Simple wrappers around ssh and scp commands.
+</PRE>
+<P>
+<HR>
+<H1><A NAME="SUBROUTINES">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_ssh">ssh HOST, COMMAND</A></STRONG><DD>
+<P>
+Calls ssh in batch mode.
+
+<DT><STRONG><A NAME="item_issh">issh HOST, COMMAND</A></STRONG><DD>
+<P>
+Prints the ssh command to be executed, waits for the user to confirm, and
+(optionally) executes the command.
+
+<DT><STRONG><A NAME="item_scp">scp SOURCE, DESTINATION</A></STRONG><DD>
+<P>
+Calls scp in batch mode.
+
+<DT><STRONG><A NAME="item_iscp">iscp SOURCE, DESTINATION</A></STRONG><DD>
+<P>
+Prints the scp command to be executed, waits for the user to confirm, and
+(optionally) executes the command.
+
+<DT><STRONG><A NAME="item_sshopen2">sshopen2 HOST, READER, WRITER, COMMAND</A></STRONG><DD>
+<P>
+Connects the supplied filehandles to the ssh process (in batch mode).
+
+<DT><STRONG><A NAME="item_sshopen3">sshopen3 HOST, WRITER, READER, ERROR, COMMAND</A></STRONG><DD>
+<P>
+Connects the supplied filehandles to the ssh process (in batch mode).
+
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+Not OO.
+
+<P>
+scp stuff should transparantly use rsync-over-ssh instead.
+
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<EM>ssh</EM>, <EM>scp</EM>, <A HREF="../IPC/Open2.html">IPC::Open2</A>, <A HREF="../IPC/Open3.html">IPC::Open3</A>
+
+
+
+</DL>
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::SessionClient - Freeside session client API</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#subroutines">SUBROUTINES</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::SessionClient - Freeside session client API</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::SessionClient qw( login portnum logout );</PRE>
+<PRE>
+ $error = login ( {
+ 'username' => $username,
+ 'password' => $password,
+ 'login' => $timestamp,
+ 'portnum' => $portnum,
+ } );</PRE>
+<PRE>
+ $portnum = portnum( { 'ip' => $ip } ) or die "unknown ip!"
+ $portnum = portnum( { 'nasnum' => $nasnum, 'nasport' => $nasport } )
+ or die "unknown nasnum/nasport";</PRE>
+<PRE>
+ $error = logout ( {
+ 'username' => $username,
+ 'password' => $password,
+ 'logout' => $timestamp,
+ 'portnum' => $portnum,
+ } );</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>This modules provides an API for a remote session application.</P>
+<P>It needs to be run as the freeside user. Because of this, the program which
+calls these subroutines should be written very carefully.</P>
+<P>
+<HR>
+<H1><A NAME="subroutines">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_login">login HASHREF</A></STRONG><BR>
+<DD>
+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.
+<P>Returns a scalar error message, or the empty string for success.</P>
+<P></P>
+<DT><STRONG><A NAME="item_portnum">portnum</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_logout">logout HASHREF</A></STRONG><BR>
+<DD>
+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.
+<P>Returns a scalar error message, or the empty string for success.</P>
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: SessionClient.html,v 1.1 2001-04-25 01:06:09 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><EM>fs_sessiond</EM></P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::SignupClient - Freeside signup client API</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#SUBROUTINES">SUBROUTINES</A>
+ <LI><A HREF="#VERSION">VERSION</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::SignupClient - Freeside signup client API
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::SignupClient qw( signup_info new_customer );
+</PRE>
+<P>
+<PRE> ( $locales, $packages, $pops ) = signup_info;
+</PRE>
+<P>
+<PRE> $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,
+ 'pkgpart' => $pkgpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'popnum' => $popnum,
+ } );
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+This module provides an API for a remote signup server.
+
+<P>
+It needs to be run as the freeside user. Because of this, the program which
+calls these subroutines should be written very carefully.
+
+<P>
+<HR>
+<H1><A NAME="SUBROUTINES">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_signup_info">signup_info</A></STRONG><DD>
+<P>
+Returns three array references of hash references.
+
+<P>
+The first set of hash references is of allowable locales. Each hash
+reference has the following keys: taxnum state county country
+
+<P>
+The second set of hash references is of allowable packages. Each hash
+reference has the following keys: pkgpart pkg
+
+<P>
+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
+
+<DT><STRONG><A NAME="item_new_customer">new_customer HASHREF</A></STRONG><DD>
+<P>
+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 pkgpart username _password popnum
+
+<P>
+Returns a scalar error message, or the empty string for success.
+
+</DL>
+<P>
+<HR>
+<H1><A NAME="VERSION">VERSION</A></H1>
+<P>
+$Id: SignupClient.html,v 1.1 2001-04-23 12:41:57 ivan Exp $
+
+<P>
+<HR>
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<EM>fs_signupd</EM>, <A HREF="./htdocs/docs/man/FS/SignupServer.html">FS::SignupServer</A>, <A HREF="./htdocs/docs/man/FS/cust_main.html">FS::cust_main</A>
+
+
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::UI::Base - Base class for all user-interface objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#history">HISTORY</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::UI::Base - Base class for all user-interface objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::UI::SomeInterface;
+ use FS::UI::some_table;</PRE>
+<PRE>
+ $interface = new FS::UI::some_table;</PRE>
+<PRE>
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<PRE>
+ package FS::UI::table_name;
+ use vars qw ( @ISA );
+ use FS::UI::Base;
+ @ISA = qw( FS::UI::Base );
+ sub db_table { 'table_name'; }</PRE>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_browse">browse</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_title">title</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_addwidget">addwidget</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: Base.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>This documentation is incomplete.</P>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF="../.././FS/UI/Gtk.html">the FS::UI::Gtk manpage</A>, <A HREF="../.././FS/UI/CGI.html">the FS::UI::CGI manpage</A></P>
+<P>
+<HR>
+<H1><A NAME="history">HISTORY</A></H1>
+<P>$Log: Base.html,v $
+<P>Revision 1.3 2001-04-23 12:40:31 ivan
+<P>documentation and webdemo updates
+<P>
+Revision 1.1 1999/08/04 09:03:53 ivan
+initial checkin of module files for proper perl installation</P>
+<P>Revision 1.1 1999/01/20 09:30:36 ivan
+skeletal cross-UI UI code.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::UI::CGI - Base class for CGI user-interface objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#history">HISTORY</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::UI::CGI - Base class for CGI user-interface objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::UI::CGI;
+ use FS::UI::some_table;</PRE>
+<PRE>
+ $interface = new FS::UI::some_table;</PRE>
+<PRE>
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::UI::CGI object represents a CGI interface object.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__header">_header</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__footer">_footer</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_interface">interface</A></STRONG><BR>
+<DD>
+Returns the string `CGI'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: CGI.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>This documentation is incomplete.</P>
+<P>In _Tableborder, headers should be links that sort on their fields.</P>
+<P>_Link uses a constant $BASE_URL</P>
+<P>_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)</P>
+<P>Still some small bits of widget code same as FS::UI::Gtk.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF="../.././FS/UI/Base.html">the FS::UI::Base manpage</A></P>
+<P>
+<HR>
+<H1><A NAME="history">HISTORY</A></H1>
+<P>$Log: CGI.html,v $
+<P>Revision 1.3 2001-04-23 12:40:31 ivan
+<P>documentation and webdemo updates
+<P>
+Revision 1.1 1999/08/04 09:03:53 ivan
+initial checkin of module files for proper perl installation</P>
+<P>Revision 1.1 1999/01/20 09:30:36 ivan
+skeletal cross-UI UI code.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::UI::Gtk - Base class for Gtk user-interface objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#history">HISTORY</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::UI::Gtk - Base class for Gtk user-interface objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::UI::Gtk;
+ use FS::UI::some_table;</PRE>
+<PRE>
+ $interface = new FS::UI::some_table;</PRE>
+<PRE>
+ $error = $interface->browse;
+ $error = $interface->search;
+ $error = $interface->view;
+ $error = $interface->edit;
+ $error = $interface->process;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::UI::Gtk object represents a Gtk user interface object.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_interface">interface</A></STRONG><BR>
+<DD>
+Returns the string `Gtk'. Useful for the author of a table-specific UI class
+to conditionally specify certain behaviour.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: Gtk.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>This documentation is incomplete.</P>
+<P>_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.</P>
+<P>There should be a persistant, per-(freeside)-user store for window positions
+and sizes and sort fields etc (see <A HREF="../.././FS/UI/CGI.html#bugs">BUGS in the FS::UI::CGI manpage</A>.</P>
+<P>Still some small bits of widget code same as FS::UI::CGI.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF="../.././FS/UI/Base.html">the FS::UI::Base manpage</A></P>
+<P>
+<HR>
+<H1><A NAME="history">HISTORY</A></H1>
+<P>$Log: Gtk.html,v $
+<P>Revision 1.3 2001-04-23 12:40:31 ivan
+<P>documentation and webdemo updates
+<P>
+Revision 1.1 1999/08/04 09:03:53 ivan
+initial checkin of module files for proper perl installation</P>
+<P>Revision 1.1 1999/01/20 09:30:36 ivan
+skeletal cross-UI UI code.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>./FS/FS/UI/agent.pm</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+<!-- INDEX END -->
+
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::UID - Subroutines for database login and assorted other stuff</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#subroutines">SUBROUTINES</A></LI>
+ <LI><A HREF="#callbacks">CALLBACKS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::UID - Subroutines for database login and assorted other stuff</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
+ checkeuid checkruid swapuid);</PRE>
+<PRE>
+ adminsuidsetup $user;</PRE>
+<PRE>
+ $cgi = new CGI;
+ $dbh = cgisuidsetup($cgi);</PRE>
+<PRE>
+ $dbh = dbh;</PRE>
+<PRE>
+ $datasrc = datasrc;</PRE>
+<PRE>
+ $driver_name = driver_name;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>Provides a hodgepodge of subroutines.</P>
+<P>
+<HR>
+<H1><A NAME="subroutines">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_adminsuidsetup">adminsuidsetup USER</A></STRONG><BR>
+<DD>
+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).
+<P></P>
+<DT><STRONG><A NAME="item_cgisuidsetup_CGI_object">cgisuidsetup CGI_object</A></STRONG><BR>
+<DD>
+Takes a single argument, which is a CGI (see <A HREF=".././FS/CGI.html">the CGI manpage</A>) or Apache (see <EM>Apache</EM>)
+object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
+<P></P>
+<DT><STRONG><A NAME="item_cgi">cgi</A></STRONG><BR>
+<DD>
+Returns the CGI (see <A HREF=".././FS/CGI.html">the CGI manpage</A>) object.
+<P></P>
+<DT><STRONG><A NAME="item_dbh">dbh</A></STRONG><BR>
+<DD>
+Returns the DBI database handle.
+<P></P>
+<DT><STRONG><A NAME="item_datasrc">datasrc</A></STRONG><BR>
+<DD>
+Returns the DBI data source.
+<P></P>
+<DT><STRONG><A NAME="item_driver_name">driver_name</A></STRONG><BR>
+<DD>
+Returns just the driver name portion of the DBI data source.
+<P></P>
+<DT><STRONG><A NAME="item_getotaker">getotaker</A></STRONG><BR>
+<DD>
+Returns the current Freeside user.
+<P></P>
+<DT><STRONG><A NAME="item_cgisetotaker">cgisetotaker</A></STRONG><BR>
+<DD>
+Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
+object (see <A HREF=".././FS/CGI.html">the CGI manpage</A>) or an Apache object (see <EM>Apache</EM>). Support for CGI::Base
+and derived classes is depriciated.
+<P></P>
+<DT><STRONG><A NAME="item_checkeuid">checkeuid</A></STRONG><BR>
+<DD>
+Returns true if effective UID is that of the freeside user.
+<P></P>
+<DT><STRONG><A NAME="item_checkruid">checkruid</A></STRONG><BR>
+<DD>
+Returns true if the real UID is that of the freeside user.
+<P></P>
+<DT><STRONG><A NAME="item_swapuid">swapuid</A></STRONG><BR>
+<DD>
+Swaps real and effective UIDs.
+<P></P>
+<DT><STRONG><A NAME="item_getsecrets_%5B_USER_%5D">getsecrets [ USER ]</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="callbacks">CALLBACKS</A></H1>
+<P>Warning: this interface is likely to change in future releases.</P>
+<P>A package can install a callback to be run in adminsuidsetup by putting a
+coderef into the hash %FS::UID::callback :</P>
+<PRE>
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ $FS::UID::callback{'Package::Name'};</PRE>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: UID.html,v 1.3 2001-04-23 12:40:30 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Too many package-global variables.</P>
+<P>Not OO.</P>
+<P>No capabilities yet. When mod_perl and Authen::DBI are implemented,
+cgisuidsetup will go away as well.</P>
+<P>Goes through contortions to support non-OO syntax with multiple datasrc's.</P>
+<P>Callbacks are inelegant.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/CGI.html">the CGI manpage</A>, <EM>DBI</EM>, config.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::agent - Object methods for agent records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::agent - Object methods for agent records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::agent;</PRE>
+<PRE>
+ $record = new FS::agent \%hash;
+ $record = new FS::agent { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $agent_type = $record->agent_type;</PRE>
+<PRE>
+ $hashref = $record->pkgpart_hashref;
+ #may purchase $pkgpart if $hashref->{$pkgpart};</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">agemtnum - primary key (assigned automatically for new agents)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_agent_%2D_Text_name_of_this_agent">agent - Text name of this agent</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_typenum_%2D_Agent_type%2E_See_FS%3A%3Aagent_type">typenum - Agent type. See <A HREF=".././FS/agent_type.html">the FS::agent_type manpage</A></A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_prog_%2D_For_future_use%2E">prog - For future use.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_freq_%2D_For_future_use%2E">freq - For future use.</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new agent. To add the agent to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this agent to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_agent_type">agent_type</A></STRONG><BR>
+<DD>
+Returns the FS::agent_type object (see <A HREF=".././FS/agent_type.html">the FS::agent_type manpage</A>) for this agent.
+<P></P>
+<DT><STRONG><A NAME="item_pkgpart_hashref">pkgpart_hashref</A></STRONG><BR>
+<DD>
+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
+<A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: agent.html,v 1.3 2001-04-23 12:40:30 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/agent_type.html">the FS::agent_type manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>,
+schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::agent_type - Object methods for agent_type records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::agent_type - Object methods for agent_type records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::agent_type;</PRE>
+<PRE>
+ $record = new FS::agent_type \%hash;
+ $record = new FS::agent_type { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $hashref = $record->pkgpart_hashref;
+ #may purchase $pkgpart if $hashref->{$pkgpart};</PRE>
+<PRE>
+ @type_pkgs = $record->type_pkgs;</PRE>
+<PRE>
+ @pkgparts = $record->pkgpart;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::agent_type object represents an agent type. Every agent (see
+<A HREF=".././FS/agent.html">the FS::agent manpage</A>) has an agent type. Agent types define which packages (see
+<A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>) may be purchased by customers (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>), via
+FS::type_pkgs records (see <A HREF=".././FS/type_pkgs.html">the FS::type_pkgs manpage</A>). FS::agent_type inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">typenum - primary key (assigned automatically for new agent types)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_atype_%2D_Text_name_of_this_agent_type">atype - Text name of this agent type</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new agent type. To add the agent type to the database, see
+<A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this agent type to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_pkgpart_hashref">pkgpart_hashref</A></STRONG><BR>
+<DD>
+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
+<A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>.
+<P></P>
+<DT><STRONG><A NAME="item_type_pkgs">type_pkgs</A></STRONG><BR>
+<DD>
+Returns all FS::type_pkgs objects (see <A HREF=".././FS/type_pkgs.html">the FS::type_pkgs manpage</A>) for this agent type.
+<P></P>
+<DT><STRONG><A NAME="item_pkgpart">pkgpart</A></STRONG><BR>
+<DD>
+Returns the pkgpart of all package definitions (see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>) for this
+agent type.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: agent_type.html,v 1.3 2001-04-23 12:40:30 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/agent.html">the FS::agent manpage</A>, <A HREF=".././FS/type_pkgs.html">the FS::type_pkgs manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>,
+<A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_bill - Object methods for cust_bill records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_bill - Object methods for cust_bill records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_bill;</PRE>
+<PRE>
+ $record = new FS::cust_bill \%hash;
+ $record = new FS::cust_bill { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ ( $total_previous_balance, @previous_cust_bill ) = $record->previous;</PRE>
+<PRE>
+ @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;</PRE>
+<PRE>
+ ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;</PRE>
+<PRE>
+ @cust_pay_objects = $cust_bill->cust_pay;</PRE>
+<PRE>
+ @lines = $cust_bill->print_text;
+ @lines = $cust_bill->print_text $time;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_bill object represents an invoice; a declaration that a customer
+owes you money. The specific charges are itemized as <STRONG>cust_bill_pkg</STRONG> records
+(see <A HREF=".././FS/cust_bill_pkg.html">the FS::cust_bill_pkg manpage</A>). FS::cust_bill inherits from FS::Record. The
+following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">invnum - primary key (assigned automatically for new invoices)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_customer">custnum - customer (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__date_%2D_specified_as_a_UNIX_timestamp%3B_see_per">_date - specified as a UNIX timestamp; see <EM>perlfunc/``time''</EM>. Also see
+<A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion functions.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_charged_%2D_amount_of_this_invoice">charged - amount of this invoice</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_automatically">printed - how many times this invoice has been printed automatically
+(see <A HREF=".././FS/cust_main.html#collect">collect in the FS::cust_main manpage</A>).</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new invoice. To add the invoice to the database, see <A HREF="#insert">insert</A>.
+Invoices are normally created by calling the bill method of a customer object
+(see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this invoice to the database (``Posts'' the invoice). If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented. I don't remove invoices because there would then be
+no record you ever posted this invoice (which is bad, no?)
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P>Only printed may be changed. printed is normally updated by calling the
+collect method of a customer object (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_previous">previous</A></STRONG><BR>
+<DD>
+Returns a list consisting of the total previous balance for this customer,
+followed by the previous outstanding invoices (as FS::cust_bill objects also).
+<P></P>
+<DT><STRONG><A NAME="item_cust_bill_pkg">cust_bill_pkg</A></STRONG><BR>
+<DD>
+Returns the line items (see <A HREF=".././FS/cust_bill_pkg.html">the FS::cust_bill_pkg manpage</A>) for this invoice.
+<P></P>
+<DT><STRONG><A NAME="item_cust_credit">cust_credit</A></STRONG><BR>
+<DD>
+Returns a list consisting of the total previous credited (see
+<A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>) for this customer, followed by the previous outstanding
+credits (FS::cust_credit objects).
+<P></P>
+<DT><STRONG><A NAME="item_cust_pay">cust_pay</A></STRONG><BR>
+<DD>
+Returns all payments (see <A HREF=".././FS/cust_pay.html">the FS::cust_pay manpage</A>) for this invoice.
+<P></P>
+<DT><STRONG><A NAME="item_owed">owed</A></STRONG><BR>
+<DD>
+Returns the amount owed (still outstanding) on this invoice, which is charged
+minus all payments (see <A HREF=".././FS/cust_pay.html">the FS::cust_pay manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_print_text_%5BTIME%5D%3B">print_text [TIME];</A></STRONG><BR>
+<DD>
+Returns an text invoice, as a list of lines.
+<P>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 <EM>perlfunc/``time''</EM>. Also see
+<A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion functions.</P>
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_bill.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The delete method.</P>
+<P>print_text formatting (and some logic :/) is in source, but needs to be
+slurped in from a file. Also number of lines ($=).</P>
+<P>missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style
+or something similar so the look can be completely customized?)</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, <A HREF=".././FS/cust_pay.html">the FS::cust_pay manpage</A>, <A HREF=".././FS/cust_bill_pkg.html">the FS::cust_bill_pkg manpage</A>,
+<A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_bill_pkg - Object methods for cust_bill_pkg records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_bill_pkg - Object methods for cust_bill_pkg records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_bill_pkg;</PRE>
+<PRE>
+ $record = new FS::cust_bill_pkg \%hash;
+ $record = new FS::cust_bill_pkg { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_invoice">invnum - invoice (see <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_package">pkgnum - package (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>) or 0 for the special virtual sales tax package</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_setup_%2D_setup_fee">setup - setup fee</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_recur_%2D_recurring_fee">recur - recurring fee</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_sdate_%2D_starting_date_of_recurring_fee">sdate - starting date of recurring fee</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_edate_%2D_ending_date_of_recurring_fee">edate - ending date of recurring fee</A></STRONG><BR>
+<DD>
+</DL>
+<P>sdate and edate are specified as UNIX timestamps; see <EM>perlfunc/``time''</EM>. Also
+see <A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion functions.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new line item. To add the line item to the database, see
+<A HREF="#insert">insert</A>. Line items are normally created by calling the bill method of a
+customer object (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this line item to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented. I don't remove line items because there would then be
+no record the items ever existed (which is bad, no?)
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Currently unimplemented. This would be even more of an accounting nightmare
+than deleteing the items. Just don't do it.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_bill_pkg.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, schema.html
+from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_credit - Object methods for cust_credit records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_credit - Object methods for cust_credit records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_credit;</PRE>
+<PRE>
+ $record = new FS::cust_credit \%hash;
+ $record = new FS::cust_credit { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_credit object represents a credit; the equivalent of a negative
+<STRONG>cust_bill</STRONG> record (see <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>). FS::cust_credit inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">crednum - primary key (assigned automatically for new credits)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_customer">custnum - customer (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_amount_%2D_amount_of_the_credit">amount - amount of the credit</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__date_%2D_specified_as_a_UNIX_timestamp%3B_see_per">_date - specified as a UNIX timestamp; see <EM>perlfunc/``time''</EM>. Also see
+<A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion functions.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_taker">otaker - order taker (assigned automatically, see <A HREF=".././FS/UID.html">the FS::UID manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_reason_%2D_text">reason - text</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new credit. To add the credit to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this credit to the database (``Posts'' the credit). If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Credits may not be modified; there would then be no record the credit was ever
+posted.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_cust_refund">cust_refund</A></STRONG><BR>
+<DD>
+Returns all refunds (see <A HREF=".././FS/cust_refund.html">the FS::cust_refund manpage</A>) for this credit.
+<P></P>
+<DT><STRONG><A NAME="item_credited">credited</A></STRONG><BR>
+<DD>
+Returns the amount of this credit that is still outstanding; which is
+amount minus all refunds (see <A HREF=".././FS/cust_refund.html">the FS::cust_refund manpage</A>).
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_credit.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The delete method.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_refund.html">the FS::cust_refund manpage</A>, <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>, schema.html from the base
+documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_main - Object methods for cust_main records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_main - Object methods for cust_main records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_main;</PRE>
+<PRE>
+ $record = new FS::cust_main \%hash;
+ $record = new FS::cust_main { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ @cust_pkg = $record->all_pkgs;</PRE>
+<PRE>
+ @cust_pkg = $record->ncancelled_pkgs;</PRE>
+<PRE>
+ $error = $record->bill;
+ $error = $record->bill %options;
+ $error = $record->bill 'time' => $time;</PRE>
+<PRE>
+ $error = $record->collect;
+ $error = $record->collect %options;
+ $error = $record->collect 'invoice_time' => $time,
+ 'batch_card' => 'yes',
+ 'report_badcard' => 'yes',
+ ;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_main object represents a customer. FS::cust_main inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">custnum - primary key (assigned automatically for new customers)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_agent">agentnum - agent (see <A HREF=".././FS/agent.html">the FS::agent manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_referral">refnum - referral (see <A HREF=".././FS/part_referral.html">the FS::part_referral manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_first_%2D_name">first - name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_last_%2D_name">last - name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_number">ss - social security number (optional)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_company_%2D_%28optional%29">company - (optional)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_address1">address1</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_address2_%2D_%28optional%29">address2 - (optional)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_city">city</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_county_%2D_%28optional%2C_see_FS%3A%3Acust_main_co">county - (optional, see <A HREF=".././FS/cust_main_county.html">the FS::cust_main_county manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_state_%2D_%28see_FS%3A%3Acust_main_county%29">state - (see <A HREF=".././FS/cust_main_county.html">the FS::cust_main_county manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_zip">zip</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_country_%2D_%28see_FS%3A%3Acust_main_county%29">country - (see <A HREF=".././FS/cust_main_county.html">the FS::cust_main_county manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_phone">daytime - phone (optional)</A></STRONG><BR>
+<DD>
+<DT><STRONG>night - phone (optional)</STRONG><BR>
+<DD>
+<DT><STRONG>fax - phone (optional)</STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_payby_%2D_%60CARD%27_%28credit_cards%29%2C_%60BILL">payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see <A HREF=".././FS/prepay_credit.html">the FS::prepay_credit manpage</A> and sets billing type to BILL)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_issuer">payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see <A HREF=".././FS/prepay_credit.html">the FS::prepay_credit manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_paydate_%2D_expiration_date%2C_mm%2Fyyyy%2C_m%2Fyy">paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_payname_%2D_name_on_card_or_billing_name">payname - name on card or billing name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_tax_%2D_tax_exempt%2C_empty_or_%60Y%27">tax - tax exempt, empty or `Y'</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_taker">otaker - order taker (assigned automatically, see <A HREF=".././FS/UID.html">the FS::UID manpage</A>)</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new customer. To add the customer to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this customer to the database. If there is an error, returns the error,
+otherwise returns false.
+<P>There is a special insert mode in which you pass a data structure to the insert
+method containing FS::cust_pkg and FS::svc_<EM>tablename</EM> objects. When
+running under a transactional database, all records are inserted atomicly, or
+the transaction is rolled back. There should be a better explanation of this,
+but until then, here's an example:</P>
+<PRE>
+ use Tie::RefHash;
+ tie %hash, 'Tie::RefHash'; #this part is important
+ %hash = {
+ $cust_pkg => [ $svc_acct ],
+ };
+ $cust_main->insert( \%hash );</PRE>
+<P></P>
+<DT><STRONG><A NAME="item_delete_NEW_CUSTNUM">delete NEW_CUSTNUM</A></STRONG><BR>
+<DD>
+This deletes the customer. If there is an error, returns the error, otherwise
+returns false.
+<P>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 <A HREF=".././FS/cust_pkg.html#cancel">cancel in the FS::cust_pkg manpage</A>).</P>
+<P>If the customer has any packages, you need to pass a new (valid) customer
+number for those packages to be transferred to.</P>
+<P>You can't delete a customer with invoices (see <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>),
+or credits (see <A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_all_pkgs">all_pkgs</A></STRONG><BR>
+<DD>
+Returns all packages (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>) for this customer.
+<P></P>
+<DT><STRONG><A NAME="item_ncancelled_pkgs">ncancelled_pkgs</A></STRONG><BR>
+<DD>
+Returns all non-cancelled packages (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>) for this customer.
+<P></P>
+<DT><STRONG><A NAME="item_bill">bill OPTIONS</A></STRONG><BR>
+<DD>
+Generates invoices (see <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>) for this customer. Usually used in
+conjunction with the collect method.
+<P>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
+<EM>perlfunc/``time''</EM>). Also see <A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion
+functions.</P>
+<P>If there is an error, returns the error, otherwise returns false.</P>
+<P></P>
+<DT><STRONG><A NAME="item_collect">collect OPTIONS</A></STRONG><BR>
+<DD>
+(Attempt to) collect money for this customer's outstanding invoices (see
+<A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>). Usually used after the bill method.
+<P>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').</P>
+<P>If there is an error, returns the error, otherwise returns false.</P>
+<P>Currently available options are:</P>
+<P>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 <EM>perlfunc/``time''</EM>). Also see <A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A>
+for conversion functions.</P>
+<P>batch_card - Set this true to batch cards (see <A HREF=".././FS/cust_pay_batch.html">the cust_pay_batch manpage</A>). By
+default, cards are processed immediately, which will generate an error if
+CyberCash is not installed.</P>
+<P>report_badcard - Set this true if you want bad card transactions to
+return an error. By default, they don't.</P>
+<P></P>
+<DT><STRONG><A NAME="item_total_owed">total_owed</A></STRONG><BR>
+<DD>
+Returns the total owed for this customer on all invoices
+(see <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_total_credited">total_credited</A></STRONG><BR>
+<DD>
+Returns the total credits (see <A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>) for this customer.
+<P></P>
+<DT><STRONG><A NAME="item_balance">balance</A></STRONG><BR>
+<DD>
+Returns the balance for this customer (total owed minus total credited).
+<P></P>
+<DT><STRONG><A NAME="item_invoicing_list_%5B_ARRAYREF_%5D">invoicing_list [ ARRAYREF ]</A></STRONG><BR>
+<DD>
+If an arguement is given, sets these email addresses as invoice recipients
+(see <A HREF=".././FS/cust_main_invoice.html">the FS::cust_main_invoice manpage</A>). Errors are not fatal and are not reported
+(except as warnings), so use check_invoicing_list first.
+<P>Returns a list of email addresses (with svcnum entries expanded).</P>
+<P>Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
+check it without disturbing anything by passing nothing.</P>
+<P>This interface may change in the future.</P>
+<P></P>
+<DT><STRONG><A NAME="item_check_invoicing_list_ARRAYREF">check_invoicing_list ARRAYREF</A></STRONG><BR>
+<DD>
+Checks these arguements as valid input for the invoicing_list method. If there
+is an error, returns the error, otherwise returns false.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_main.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The delete method.</P>
+<P>The delete method should possibly take an FS::cust_main object reference
+instead of a scalar customer number.</P>
+<P>Bill and collect options should probably be passed as references instead of a
+list.</P>
+<P>CyberCash v2 forces us to define some variables in package main.</P>
+<P>There should probably be a configuration file with a list of allowed credit
+card types.</P>
+<P>CyberCash is the only processor.</P>
+<P>No multiple currency support (probably a larger project than just this module).</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>, <A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>
+<A HREF=".././FS/cust_pay_batch.html">the FS::cust_pay_batch manpage</A>, <A HREF=".././FS/agent.html">the FS::agent manpage</A>, <A HREF=".././FS/part_referral.html">the FS::part_referral manpage</A>,
+<A HREF=".././FS/cust_main_county.html">the FS::cust_main_county manpage</A>, <A HREF=".././FS/cust_main_invoice.html">the FS::cust_main_invoice manpage</A>,
+<A HREF=".././FS/UID.html">the FS::UID manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_main_county - Object methods for cust_main_county objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_main_county - Object methods for cust_main_county objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_main_county;</PRE>
+<PRE>
+ $record = new FS::cust_main_county \%hash;
+ $record = new FS::cust_main_county { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">taxnum - primary key (assigned automatically for new tax rates)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_state">state</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_county">county</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_country">country</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_tax_%2D_percentage">tax - percentage</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new tax rate. To add the tax rate to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this tax rate to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this tax rate from the database. If there is an error, returns the
+error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_main_county.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>, schema.html from the base
+documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_main_invoice - Object methods for cust_main_invoice records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_main_invoice - Object methods for cust_main_invoice records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_main_invoice;</PRE>
+<PRE>
+ $record = new FS::cust_main_invoice \%hash;
+ $record = new FS::cust_main_invoice { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $email_address = $record->address;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_main_invoice object represents an invoice destination. FS::cust_main_invoice inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_destnum_%2D_primary_key">destnum - primary key</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_customer">custnum - customer (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_svcnum">dest - Invoice destination: If numeric, a svcnum (see <A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>), if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new invoice destination. To add the invoice destination to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_checkdest">checkdest</A></STRONG><BR>
+<DD>
+Checks the dest field only.
+<P></P>
+<DT><STRONG><A NAME="item_address">address</A></STRONG><BR>
+<DD>
+Returns the literal email address for this record (or `POST').
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_main_invoice.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A></P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_pay - Object methods for cust_pay objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_pay - Object methods for cust_pay objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_pay;</PRE>
+<PRE>
+ $record = new FS::cust_pay \%hash;
+ $record = new FS::cust_pay { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">paynum - primary key (assigned automatically for new payments)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_Invoice">invnum - Invoice (see <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_paid_%2D_Amount_of_this_payment">paid - Amount of this payment</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__date_%2D_specified_as_a_UNIX_timestamp%3B_see_per">_date - specified as a UNIX timestamp; see <EM>perlfunc/``time''</EM>. Also see
+<A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion functions.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_payby_%2D_%60CARD%27_%28credit_cards%29%2C_%60BILL">payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_issuer">payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_paybatch_%2D_text_field_for_tracking_card_processi">paybatch - text field for tracking card processing</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new payment. To add the payment to the databse, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this payment to the databse, and updates the invoice (see
+<A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented (accounting reasons).
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Currently unimplemented (accounting reasons).
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_pay.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Delete and replace methods.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_bill.html">the FS::cust_bill manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_pay_batch - Object methods for batch cards</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_pay_batch - Object methods for batch cards</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_pay_batch;</PRE>
+<PRE>
+ $record = new FS::cust_pay_batch \%hash;
+ $record = new FS::cust_pay_batch { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_trancode_%2D_77_for_charges">trancode - 77 for charges</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_cardnum">cardnum</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_exp_%2D_card_expiration">exp - card expiration</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_amount">amount</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_invnum_%2D_invoice">invnum - invoice</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_custnum_%2D_customer">custnum - customer</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_payname_%2D_name_on_card">payname - name on card</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_first_%2D_name">first - name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_last_%2D_name">last - name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_address1">address1</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_address2">address2</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_city">city</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_state">state</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_zip">zip</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_country">country</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new record. To add the record to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+#inactive
+#
+#Replaces the OLD_RECORD with this one in the database. If there is an error,
+#returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_pay_batch.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>There should probably be a configuration file with a list of allowed credit
+card types.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, <A HREF=".././FS/Record.html">the FS::Record manpage</A></P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_pkg - Object methods for cust_pkg objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#subroutines">SUBROUTINES</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_pkg - Object methods for cust_pkg objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_pkg;</PRE>
+<PRE>
+ $record = new FS::cust_pkg \%hash;
+ $record = new FS::cust_pkg { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->cancel;</PRE>
+<PRE>
+ $error = $record->suspend;</PRE>
+<PRE>
+ $error = $record->unsuspend;</PRE>
+<PRE>
+ $part_pkg = $record->part_pkg;</PRE>
+<PRE>
+ @labels = $record->labels;</PRE>
+<PRE>
+ $error = FS::cust_pkg::order( $custnum, \@pkgparts );
+ $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
+inherits from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">pkgnum - primary key (assigned automatically for new billing items)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_Customer">custnum - Customer (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_definition">pkgpart - Billing item definition (see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_setup_%2D_date">setup - date</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_bill_%2D_date">bill - date</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_susp_%2D_date">susp - date</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_expire_%2D_date">expire - date</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_cancel_%2D_date">cancel - date</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_taker">otaker - order taker (assigned automatically if null, see <A HREF=".././FS/UID.html">the FS::UID manpage</A>)</A></STRONG><BR>
+<DD>
+</DL>
+<P>Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
+see <EM>perlfunc/``time''</EM>. Also see <A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for
+conversion functions.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Create a new billing item. To add the item to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this billing item to the database (``Orders'' the item). If there is an
+error, returns the error, otherwise returns false.
+<P>sub insert {
+ my $self = shift;</P>
+<PRE>
+ # custnum might not have have been defined in sub check (for one-shot new
+ # customers), so check it here instead</PRE>
+<PRE>
+ my $error = $self->ut_number('custnum');
+ return $error if $error</PRE>
+<PRE>
+ return "Unknown customer"
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );</PRE>
+<PRE>
+ $self->SUPER::insert;</PRE>
+<P>}</P>
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P>Currently, custnum, setup, bill, susp, expire, and cancel may be changed.</P>
+<P>Changing pkgpart may have disasterous effects. See the order subroutine.</P>
+<P>setup and bill are normally updated by calling the bill method of a customer
+object (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>).</P>
+<P>suspend is normally updated by the suspend and unsuspend methods.</P>
+<P>cancel is normally updated by the cancel method (and also the order subroutine
+in some cases).</P>
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_cancel">cancel</A></STRONG><BR>
+<DD>
+Cancels and removes all services (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A> and <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>)
+in this package, then cancels the package itself (sets the cancel field to
+now).
+<P>If there is an error, returns the error, otherwise returns false.</P>
+<P></P>
+<DT><STRONG><A NAME="item_suspend">suspend</A></STRONG><BR>
+<DD>
+Suspends all services (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A> and <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>) in this
+package, then suspends the package itself (sets the susp field to now).
+<P>If there is an error, returns the error, otherwise returns false.</P>
+<P></P>
+<DT><STRONG><A NAME="item_unsuspend">unsuspend</A></STRONG><BR>
+<DD>
+Unsuspends all services (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A> and <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>) in this
+package, then unsuspends the package itself (clears the susp field).
+<P>If there is an error, returns the error, otherwise returns false.</P>
+<P></P>
+<DT><STRONG><A NAME="item_part_pkg">part_pkg</A></STRONG><BR>
+<DD>
+Returns the definition for this billing item, as an FS::part_pkg object (see
+<A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_labels">labels</A></STRONG><BR>
+<DD>
+Returns a list of lists, calling the label method for all services
+(see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) of this billing item.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="subroutines">SUBROUTINES</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_order_CUSTNUM%2C_PKGPARTS_ARYREF%2C_%5B_REMOVE_PKG">order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]</A></STRONG><BR>
+<DD>
+CUSTNUM is a customer (see <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>)
+<P>PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
+<A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>) to order for this customer. Duplicates are of course
+permitted.</P>
+<P>REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
+remove for this customer. The services (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) are moved to the
+new billing items. An error is returned if this is not possible (see
+<A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>).</P>
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_pkg.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?</P>
+<P>In sub order, the @pkgparts array (passed by reference) is clobbered.</P>
+<P>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.</P>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>
+, <A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>, schema.html from the base documentation</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_refund - Object method for cust_refund objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_refund - Object method for cust_refund objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_refund;</PRE>
+<PRE>
+ $record = new FS::cust_refund \%hash;
+ $record = new FS::cust_refund { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_refund represents a refund: the transfer of money to a customer;
+equivalent to a negative payment (see <A HREF=".././FS/cust_pay.html">the FS::cust_pay manpage</A>). FS::cust_refund
+inherits from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">refundnum - primary key (assigned automatically for new refunds)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_Credit">crednum - Credit (see <A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_refund_%2D_Amount_of_the_refund">refund - Amount of the refund</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__date_%2D_specified_as_a_UNIX_timestamp%3B_see_per">_date - specified as a UNIX timestamp; see <EM>perlfunc/``time''</EM>. Also see
+<A HREF="../Time/Local.html">the Time::Local manpage</A> and <A HREF="../Date/Parse.html">the Date::Parse manpage</A> for conversion functions.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_payby_%2D_%60CARD%27_%28credit_cards%29%2C_%60BILL">payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_issuer">payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_taker">otaker - order taker (assigned automatically, see <A HREF=".././FS/UID.html">the FS::UID manpage</A>)</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new refund. To add the refund to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this refund to the database, and updates the credit (see
+<A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented (accounting reasons).
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Currently unimplemented (accounting reasons).
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_refund.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Delete and replace methods.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_credit.html">the FS::cust_credit manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::cust_svc - Object method for cust_svc objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::cust_svc - Object method for cust_svc objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::cust_svc;</PRE>
+<PRE>
+ $record = new FS::cust_svc \%hash
+ $record = new FS::cust_svc { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ ($label, $value) = $record->label;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
+The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">svcnum - primary key (assigned automatically for new services)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_Package">pkgnum - Package (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_definition">svcpart - Service definition (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>)</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new service. To add the refund to the database, see <A HREF="#insert">insert</A>.
+Services are normally created by creating FS::svc_ objects (see
+<A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>, <A HREF=".././FS/svc_domain.html">the FS::svc_domain manpage</A>, and <A HREF=".././FS/svc_acct_sm.html">the FS::svc_acct_sm manpage</A>, among others).
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this service to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this service from the database. If there is an error, returns the
+error, otherwise returns false.
+<P>Called by the cancel method of the package (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_label">label</A></STRONG><BR>
+<DD>
+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
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: cust_svc.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Behaviour of changing the svcpart of cust_svc records is undefined and should
+possibly be prohibited, and pkg_svc records are not checked.</P>
+<P>pkg_svc records are not checked in general (here).</P>
+<P>Deleting this record doesn't check or delete the svc_* record associated
+with this record.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, <A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>,
+schema.html from the base documentation</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::dbdef - Database objects</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#METHODS">METHODS</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::dbdef - Database objects
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::dbdef;
+</PRE>
+<P>
+<PRE> $dbdef = new FS::dbdef (@dbdef_table_objects);
+ $dbdef = load FS::dbdef "filename";
+</PRE>
+<P>
+<PRE> $dbdef->save("filename");
+</PRE>
+<P>
+<PRE> $dbdef->addtable($dbdef_table_object);
+</PRE>
+<P>
+<PRE> @table_names = $dbdef->tables;
+</PRE>
+<P>
+<PRE> $FS_dbdef_table_object = $dbdef->table;
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+FS::dbdef objects are collections of FS::dbdef_table objects and represnt a
+database (a collection of tables).
+
+<P>
+<HR>
+<H1><A NAME="METHODS">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new TABLE, TABLE, ...</A></STRONG><DD>
+<P>
+Creates a new FS::dbdef object
+
+<DT><STRONG><A NAME="item_load">load FILENAME</A></STRONG><DD>
+<P>
+Loads an FS::dbdef object from a file.
+
+<DT><STRONG><A NAME="item_save">save FILENAME</A></STRONG><DD>
+<P>
+Saves an FS::dbdef object to a file.
+
+<DT><STRONG><A NAME="item_addtable">addtable TABLE</A></STRONG><DD>
+<P>
+Adds this FS::dbdef_table object.
+
+<DT><STRONG><A NAME="item_tables">tables</A></STRONG><DD>
+<P>
+Returns the names of all tables.
+
+<DT><STRONG><A NAME="item_table">table TABLENAME</A></STRONG><DD>
+<P>
+Returns the named FS::dbdef_table object.
+
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+Each FS::dbdef object should have a name which corresponds to its name
+within the SQL database engine.
+
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<A HREF="../FS/dbdef_table.html">FS::dbdef_table</A>, <A HREF="../FS/Record.html">FS::Record</A>,
+
+</DL>
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::dbdef_colgroup - Column group objects</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#METHODS">METHODS</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::dbdef_colgroup - Column group objects
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::dbdef_colgroup;
+</PRE>
+<P>
+<PRE> $colgroup = new FS::dbdef_colgroup ( $lol );
+ $colgroup = new FS::dbdef_colgroup (
+ [
+ [ 'single_column' ],
+ [ 'multiple_columns', 'another_column', ],
+ ]
+ );
+</PRE>
+<P>
+<PRE> @sql_lists = $colgroup->sql_list;
+</PRE>
+<P>
+<PRE> @singles = $colgroup->singles;
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+FS::dbdef_colgroup objects represent sets of sets of columns.
+
+<P>
+<HR>
+<H1><A NAME="METHODS">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new</A></STRONG><DD>
+<P>
+Creates a new FS::dbdef_colgroup object.
+
+<DT><STRONG><A NAME="item_sql_list">sql_list</A></STRONG><DD>
+<P>
+Returns a flat list of comma-separated values, for SQL statements.
+
+<DT><STRONG><A NAME="item_singles">singles</A></STRONG><DD>
+<P>
+Returns a flat list of all single item lists.
+
+</DL>
+<P>
+<HR>
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<A HREF="../FS/dbdef_table.html">FS::dbdef_table</A>, <A HREF="../FS/dbdef_unique.html">FS::dbdef_unique</A>, <A HREF="../FS/dbdef_index.html">FS::dbdef_index</A>,
+<A HREF="../FS/dbdef_column.html">FS::dbdef_column</A>, <A HREF="../FS/dbdef.html">FS::dbdef</A>, <EM>perldsc</EM>
+
+
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::dbdef_column - Column object</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#METHODS">METHODS</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+ <LI><A HREF="#VERSION">VERSION</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::dbdef_column - Column object
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::dbdef_column;
+</PRE>
+<P>
+<PRE> $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 );
+</PRE>
+<P>
+<PRE> $name = $column_object->name;
+ $column_object->name ( 'name' );
+</PRE>
+<P>
+<PRE> $name = $column_object->type;
+ $column_object->name ( 'sql_type' );
+</PRE>
+<P>
+<PRE> $name = $column_object->null;
+ $column_object->name ( 'NOT NULL' );
+</PRE>
+<P>
+<PRE> $name = $column_object->length;
+ $column_object->name ( $length );
+</PRE>
+<P>
+<PRE> $sql_line = $column->line;
+ $sql_line = $column->line $datasrc;
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+FS::dbdef::column objects represend columns in tables (see <A HREF="../FS/dbdef_table.html">FS::dbdef_table</A>).
+
+<P>
+<HR>
+<H1><A NAME="METHODS">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new</A></STRONG><DD>
+<P>
+Creates a new FS::dbdef_column object.
+
+<DT><STRONG><A NAME="item_name">name</A></STRONG><DD>
+<P>
+Returns or sets the column name.
+
+<DT><STRONG><A NAME="item_type">type</A></STRONG><DD>
+<P>
+Returns or sets the column type.
+
+<DT><STRONG><A NAME="item_null">null</A></STRONG><DD>
+<P>
+Returns or sets the column null flag.
+
+<DT><STRONG>type</STRONG><DD>
+<P>
+Returns or sets the column length.
+
+<DT><STRONG><A NAME="item_line">line [ $datasrc ]</A></STRONG><DD>
+<P>
+Returns an SQL column definition.
+
+<P>
+If passed a DBI <CODE>$datasrc</CODE> specifying <A HREF="../DBD/mysql.html">DBD::mysql</A> or <A HREF="../DBD/Pg.html">DBD::Pg</A>, will use engine-specific syntax.
+
+</DL>
+<P>
+<HR>
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<A HREF="../FS/dbdef_table.html">FS::dbdef_table</A>, <A HREF="../FS/dbdef.html">FS::dbdef</A>, <EM>DBI</EM>
+
+
+
+<P>
+<HR>
+<H1><A NAME="VERSION">VERSION</A></H1>
+<P>
+$Id: dbdef_column.html,v 1.2 2000-03-03 18:22:43 ivan Exp $
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::dbdef_unique.pm - Index object</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::dbdef_unique.pm - Index object
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::dbdef_index;
+</PRE>
+<P>
+<PRE> # see FS::dbdef_colgroup methods
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+FS::dbdef_unique objects represent the (non-unique) indices of a table (<A HREF="../FS/dbdef_table.html">FS::dbdef_table</A>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
+
+<P>
+<HR>
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+Is this empty subclass needed?
+
+<P>
+<HR>
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<A HREF="../FS/dbdef_colgroup.html">FS::dbdef_colgroup</A>, <A HREF="../FS/dbdef_record.html">FS::dbdef_record</A>, <A HREF="../FS/Record.html">FS::Record</A>
+
+
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::dbdef_table - Table objects</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#METHODS">METHODS</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+ <LI><A HREF="#VERSION">VERSION</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::dbdef_table - Table objects
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::dbdef_table;
+</PRE>
+<P>
+<PRE> $dbdef_table = new FS::dbdef_table (
+ "table_name",
+ "primary_key",
+ $FS_dbdef_unique_object,
+ $FS_dbdef_index_object,
+ @FS_dbdef_column_objects,
+ );
+</PRE>
+<P>
+<PRE> $dbdef_table->addcolumn ( $FS_dbdef_column_object );
+</PRE>
+<P>
+<PRE> $table_name = $dbdef_table->name;
+ $dbdef_table->name ("table_name");
+</PRE>
+<P>
+<PRE> $table_name = $dbdef_table->primary_keye;
+ $dbdef_table->primary_key ("primary_key");
+</PRE>
+<P>
+<PRE> $FS_dbdef_unique_object = $dbdef_table->unique;
+ $dbdef_table->unique ( $FS_dbdef_unique_object );
+</PRE>
+<P>
+<PRE> $FS_dbdef_index_object = $dbdef_table->index;
+ $dbdef_table->index ( $FS_dbdef_index_object );
+</PRE>
+<P>
+<PRE> @column_names = $dbdef->columns;
+</PRE>
+<P>
+<PRE> $FS_dbdef_column_object = $dbdef->column;
+</PRE>
+<P>
+<PRE> @sql_statements = $dbdef->sql_create_table;
+ @sql_statements = $dbdef->sql_create_table $datasrc;
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+FS::dbdef_table objects represent a single database table.
+
+<P>
+<HR>
+<H1><A NAME="METHODS">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new</A></STRONG><DD>
+<P>
+Creates a new FS::dbdef_table object.
+
+<DT><STRONG><A NAME="item_addcolumn">addcolumn</A></STRONG><DD>
+<P>
+Adds this FS::dbdef_column object.
+
+<DT><STRONG><A NAME="item_name">name</A></STRONG><DD>
+<P>
+Returns or sets the table name.
+
+<DT><STRONG><A NAME="item_primary_key">primary_key</A></STRONG><DD>
+<P>
+Returns or sets the primary key.
+
+<DT><STRONG><A NAME="item_unique">unique</A></STRONG><DD>
+<P>
+Returns or sets the FS::dbdef_unique object.
+
+<DT><STRONG><A NAME="item_index">index</A></STRONG><DD>
+<P>
+Returns or sets the FS::dbdef_index object.
+
+<DT><STRONG><A NAME="item_columns">columns</A></STRONG><DD>
+<P>
+Returns a list consisting of the names of all columns.
+
+<DT><STRONG><A NAME="item_column">column "column"</A></STRONG><DD>
+<P>
+Returns the column object (see <A HREF="../FS/dbdef_column.html">FS::dbdef_column</A>) for ``column''.
+
+<DT><STRONG><A NAME="item_sql_create_table">sql_create_table [ $datasrc ]</A></STRONG><DD>
+<P>
+Returns an array of SQL statments to create this table.
+
+<P>
+If passed a DBI <CODE>$datasrc</CODE> specifying <A HREF="../DBD/mysql.html">DBD::mysql</A>, will use MySQL-specific syntax. Non-standard syntax for other engines (if
+applicable) may also be supported in the future.
+
+</DL>
+<P>
+<HR>
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<A HREF="../FS/dbdef.html">FS::dbdef</A>, <A HREF="../FS/dbdef_unique.html">FS::dbdef_unique</A>, <A HREF="../FS/dbdef_index.html">FS::dbdef_index</A>, <A HREF="../FS/dbdef_unique.html">FS::dbdef_unique</A>,
+<EM>DBI</EM>
+
+
+
+<P>
+<HR>
+<H1><A NAME="VERSION">VERSION</A></H1>
+<P>
+$Id: dbdef_table.html,v 1.2 2000-03-03 18:22:43 ivan Exp $
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::dbdef_unique.pm - Unique object</TITLE>
+<LINK REV="made" HREF="mailto:none">
+</HEAD>
+
+<BODY>
+
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#NAME">NAME</A>
+ <LI><A HREF="#SYNOPSIS">SYNOPSIS</A>
+ <LI><A HREF="#DESCRIPTION">DESCRIPTION</A>
+ <LI><A HREF="#BUGS">BUGS</A>
+ <LI><A HREF="#SEE_ALSO">SEE ALSO</A>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="NAME">NAME</A></H1>
+<P>
+FS::dbdef_unique.pm - Unique object
+
+<P>
+<HR>
+<H1><A NAME="SYNOPSIS">SYNOPSIS</A></H1>
+<P>
+<PRE> use FS::dbdef_unique;
+</PRE>
+<P>
+<PRE> # see FS::dbdef_colgroup methods
+</PRE>
+<P>
+<HR>
+<H1><A NAME="DESCRIPTION">DESCRIPTION</A></H1>
+<P>
+FS::dbdef_unique objects represent the unique indices of a database table (<A HREF="../FS/dbdef_table.html">FS::dbdef_table</A>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
+
+<P>
+<HR>
+<H1><A NAME="BUGS">BUGS</A></H1>
+<P>
+Is this empty subclass needed?
+
+<P>
+<HR>
+<H1><A NAME="SEE_ALSO">SEE ALSO</A></H1>
+<P>
+<A HREF="../FS/dbdef_colgroup.html">FS::dbdef_colgroup</A>, <A HREF="../FS/dbdef_record.html">FS::dbdef_record</A>, <A HREF="../FS/Record.html">FS::Record</A>
+
+
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::domain_record - Object methods for domain_record records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#history">HISTORY</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::domain_record - Object methods for domain_record records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::domain_record;</PRE>
+<PRE>
+ $record = new FS::domain_record \%hash;
+ $record = new FS::domain_record { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_recnum_%2D_primary_key">recnum - primary key</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_Domain">svcnum - Domain (see <A HREF=".././FS/svc_domain.html">the FS::svc_domain manpage</A>) of this entry</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_partial">reczone - partial (or full) zone for this entry</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_recaf_%2D_address_family_for_this_entry%2C_current">recaf - address family for this entry, currently only `IN' is recognized.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_entry">rectype - record type for this entry (A, MX, etc.)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_recdata_%2D_data_for_this_entry">recdata - data for this entry</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new entry. To add the example to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: domain_record.html,v 1.1 2001-04-23 12:41:57 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>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. :)</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, schema.html from the base documentation.</P>
+<P>
+<HR>
+<H1><A NAME="history">HISTORY</A></H1>
+<P>$Log: domain_record.html,v $
+<P>Revision 1.1 2001-04-23 12:41:57 ivan
+<P>new API documentation
+<P>
+Revision 1.1 2000/02/03 05:16:52 ivan
+beginning of DNS and Apache support</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::nas - Object methods for nas records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::nas - Object methods for nas records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::nas;</PRE>
+<PRE>
+ $record = new FS::nas \%hash;
+ $record = new FS::nas {
+ 'nasnum' => 1,
+ 'nasip' => '10.4.20.23',
+ 'nasfqdn' => 'box1.brc.nv.us.example.net',
+ };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->heartbeat($timestamp);</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_nasnum_%2D_primary_key">nasnum - primary key</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_nas_%2D_NAS_name">nas - NAS name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_nasip_%2D_NAS_ip_address">nasip - NAS ip address</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_nasfqdn_%2D_NAS_fully%2Dqualified_domain_name">nasfqdn - NAS fully-qualified domain name</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_state">last - timestamp indicating the last instant the NAS was in a known
+ state (used by the session monitoring).</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new NAS. To add the NAS to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_heartbeat">heartbeat TIMESTAMP</A></STRONG><BR>
+<DD>
+Updates the timestamp for this nas
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: nas.html,v 1.1 2001-04-23 12:41:57 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::part_pkg - Object methods for part_pkg objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::part_pkg - Object methods for part_pkg objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::part_pkg;</PRE>
+<PRE>
+ $record = new FS::part_pkg \%hash
+ $record = new FS::part_pkg { 'column' => 'value' };</PRE>
+<PRE>
+ $custom_record = $template_record->clone;</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ @pkg_svc = $record->pkg_svc;</PRE>
+<PRE>
+ $svcnum = $record->svcpart;
+ $svcnum = $record->svcpart( 'svc_acct' );</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::part_pkg object represents a billing item definition. FS::part_pkg
+inherits from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">pkgpart - primary key (assigned automatically for new billing item definitions)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_definition">pkg - Text name of this billing item definition (customer-viewable)</A></STRONG><BR>
+<DD>
+<DT><STRONG>comment - Text name of this billing item definition (non-customer-viewable)</STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_setup_%2D_Setup_fee">setup - Setup fee</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_freq_%2D_Frequency_of_recurring_fee">freq - Frequency of recurring fee</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_recur_%2D_Recurring_fee">recur - Recurring fee</A></STRONG><BR>
+<DD>
+</DL>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new billing item definition. To add the billing item definition to
+the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_clone">clone</A></STRONG><BR>
+<DD>
+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
+<A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this billing item definition to the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_pkg_svc">pkg_svc</A></STRONG><BR>
+<DD>
+Returns all FS::pkg_svc objects (see <A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>) for this package
+definition (with non-zero quantity).
+<P></P>
+<DT><STRONG><A NAME="item_svcpart_%5B_SVCDB_%5D">svcpart [ SVCDB ]</A></STRONG><BR>
+<DD>
+Returns the svcpart of a single service definition (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>)
+associated with this billing item definition (see <A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>). 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,
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: part_pkg.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The delete method is unimplemented.</P>
+<P>setup and recur semantics are not yet defined (and are implemented in
+FS::cust_bill. hmm.).</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, <A HREF=".././FS/type_pkgs.html">the FS::type_pkgs manpage</A>, <A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>, <EM>Safe</EM>.
+schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::part_referral - Object methods for part_referral objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::part_referral - Object methods for part_referral objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::part_referral;</PRE>
+<PRE>
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">refnum - primary key (assigned automatically for new referrals)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_referral_%2D_Text_name_of_this_referral">referral - Text name of this referral</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new referral. To add the referral to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this referral to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: part_referral.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The delete method is unimplemented.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_main.html">the FS::cust_main manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::part_svc - Object methods for part_svc objects</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::part_svc - Object methods for part_svc objects</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::part_svc;</PRE>
+<PRE>
+ $record = new FS::part_referral \%hash
+ $record = new FS::part_referral { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::part_svc represents a service definition. FS::part_svc inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">svcpart - primary key (assigned automatically for new service definitions)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_svc_%2D_text_name_of_this_service_definition">svc - text name of this service definition</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_svcdb_%2D_table_used_for_this_service%2E_See_FS%3A">svcdb - table used for this service. See <A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>,
+<A HREF=".././FS/svc_domain.html">the FS::svc_domain manpage</A>, and <A HREF=".././FS/svc_acct_sm.html">the FS::svc_acct_sm manpage</A>, among others.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_svcdb__field_%2D_Default_or_fixed_value_for_field_"><EM>svcdb</EM>__<EM>field</EM> - Default or fixed value for <EM>field</EM> in <EM>svcdb</EM>.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_svcdb__field_flag_%2D_defines_svcdb__field_action%"><EM>svcdb</EM>__<EM>field</EM>_flag - defines <EM>svcdb</EM>__<EM>field</EM> action: null, `D' for default, or `F' for fixed</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new service definition. To add the service definition to the
+database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this service definition to the database. If there is an error, returns
+the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Currently unimplemented.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: part_svc.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>Delete is unimplemented.</P>
+<P>The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this
+should be fixed.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>, <A HREF=".././FS/pkg_svc.html">the FS::pkg_svc manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>,
+<A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>, <A HREF=".././FS/svc_acct_sm.html">the FS::svc_acct_sm manpage</A>, <A HREF=".././FS/svc_domain.html">the FS::svc_domain manpage</A>, schema.html from the
+base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::pkg_svc - Object methods for pkg_svc records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::pkg_svc - Object methods for pkg_svc records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::pkg_svc;</PRE>
+<PRE>
+ $record = new FS::pkg_svc \%hash;
+ $record = new FS::pkg_svc { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $part_pkg = $record->part_pkg;</PRE>
+<PRE>
+ $part_svc = $record->part_svc;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::pkg_svc record links a billing item definition (see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>) to
+a service definition (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>). FS::pkg_svc inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_definition">pkgpart - Billing item definition (see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG>svcpart - Service definition (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>)</STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_quantity_%2D_Quantity_of_this_service_definition_t">quantity - Quantity of this service definition that this billing item
+definition includes</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Create a new record. To add the record to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this record from the database. If there is an error, returns the
+error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_part_pkg">part_pkg</A></STRONG><BR>
+<DD>
+Returns the FS::part_pkg object (see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_part_svc">part_svc</A></STRONG><BR>
+<DD>
+Returns the FS::part_svc object (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>).
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: pkg_svc.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>, <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, schema.html from the base
+documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::port - Object methods for port records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::port - Object methods for port records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::port;</PRE>
+<PRE>
+ $record = new FS::port \%hash;
+ $record = new FS::port { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $session = $port->session;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::port object represents an individual port on a NAS. FS::port inherits
+from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_portnum_%2D_primary_key">portnum - primary key</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_ip_%2D_IP_address_of_this_port">ip - IP address of this port</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_nasport_%2D_port_number_on_the_NAS">nasport - port number on the NAS</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_nasnum_%2D_NAS_this_port_is_on_%2D_see_FS%3A%3Anas">nasnum - NAS this port is on - see <A HREF=".././FS/nas.html">the FS::nas manpage</A></A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new port. To add the example to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_session">session</A></STRONG><BR>
+<DD>
+Returns the currently open session on this port, or if no session is currently
+open, the most recent session. See <A HREF=".././FS/session.html">the FS::session manpage</A>.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: port.html,v 1.1 2001-04-23 12:41:57 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The author forgot to customize this manpage.</P>
+<P>The session method won't deal well if you have multiple open sessions on a
+port, for example if your RADIUS server drops <STRONG>stop</STRONG> 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.</P>
+<P>If you think the above refers multiple user logins you need to read the
+manpages again.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::prepay_credit - Object methods for prepay_credit records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#history">HISTORY</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::prepay_credit - Object methods for prepay_credit records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::prepay_credit;</PRE>
+<PRE>
+ $record = new FS::prepay_credit \%hash;
+ $record = new FS::prepay_credit {
+ 'identifier' => '4198123455512121'
+ 'amount' => '19.95',
+ };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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:</P>
+<DL>
+<DT><STRONG><A NAME="item_field_%2D_description">field - description</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_identifier_%2D_identifier_entered_by_the_user_to_r">identifier - identifier entered by the user to receive the credit</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_amount_%2D_amount_of_the_credit">amount - amount of the credit</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new pre-paid credit. To add the example to the database, see
+<A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: prepay_credit.html,v 1.1 2001-04-23 12:41:57 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, schema.html from the base documentation.</P>
+<P>
+<HR>
+<H1><A NAME="history">HISTORY</A></H1>
+<P>$Log: prepay_credit.html,v $
+<P>Revision 1.1 2001-04-23 12:41:57 ivan
+<P>new API documentation
+<P>
+Revision 1.2 2000/02/02 20:22:18 ivan
+bugfix prepayment in signup server</P>
+<P>Revision 1.1 2000/01/31 05:22:23 ivan
+prepaid ``internet cards''</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::session - Object methods for session records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::session - Object methods for session records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::session;</PRE>
+<PRE>
+ $record = new FS::session \%hash;
+ $record = new FS::session {
+ 'portnum' => 1,
+ 'svcnum' => 2,
+ 'login' => $timestamp,
+ 'logout' => $timestamp,
+ };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->nas_heartbeat($timestamp);</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::session object represents an user login session. FS::session inherits
+from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_sessionnum_%2D_primary_key">sessionnum - primary key</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_portnum_%2D_NAS_port_for_this_session_%2D_see_FS%3">portnum - NAS port for this session - see <A HREF=".././FS/port.html">the FS::port manpage</A></A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_svcnum_%2D_User_for_this_session_%2D_see_FS%3A%3As">svcnum - User for this session - see <A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A></A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_login_%2D_timestamp_indicating_the_beginning_of_th">login - timestamp indicating the beginning of this user session.</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_logout_%2D_timestamp_indicating_the_end_of_this_us">logout - timestamp indicating the end of this user session. May be null,
+ which indicates a currently open session.</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new session. To add the session to the database, see <A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P>
+<DT><STRONG><A NAME="item_nas_heartbeat">nas_heartbeat</A></STRONG><BR>
+<DD>
+Heartbeats the nas associated with this session (see <A HREF=".././FS/nas.html">the FS::nas manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_svc_acct">svc_acct</A></STRONG><BR>
+<DD>
+Returns the svc_acct record associated with this session (see <A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>).
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: session.html,v 1.1 2001-04-23 12:41:57 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>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*</P>
+<P>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).</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::svc_Common - Object method for all svc_ records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::svc_Common - Object method for all svc_ records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<P>use FS::svc_Common;</P>
+<P>@ISA = qw( FS::svc_Common );</P>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P>The additional fields pkgnum and svcpart (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) should be
+defined. An FS::cust_svc record will be created and inserted.</P>
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this account from the database. If there is an error, returns the
+error, otherwise returns false.
+<P>The corresponding FS::cust_svc record will be deleted as well.</P>
+<P></P>
+<DT><STRONG><A NAME="item_setfixed">setfixed</A></STRONG><BR>
+<DD>
+Sets any fixed fields for this service (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>). If there is an
+error, returns the error, otherwise returns the FS::part_svc object (use <CODE>ref()</CODE>
+to test the return). Usually called by the check method.
+<P></P>
+<DT><STRONG><A NAME="item_setdefault">setdefault</A></STRONG><BR>
+<DD>
+Sets all fields to their defaults (see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>), overriding their
+current values. If there is an error, returns the error, otherwise returns
+the FS::part_svc object (use <CODE>ref()</CODE> to test the return).
+<P></P>
+<DT><STRONG><A NAME="item_suspend">suspend</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_unsuspend">unsuspend</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_cancel">cancel</A></STRONG><BR>
+<DD>
+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 <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: svc_Common.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The setfixed method return value.</P>
+<P>The new method should set defaults from part_svc (like the check method
+sets fixed values)?</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>, <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, schema.html
+from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::svc_acct - Object methods for svc_acct records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::svc_acct - Object methods for svc_acct records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::svc_acct;</PRE>
+<PRE>
+ $record = new FS::svc_acct \%hash;
+ $record = new FS::svc_acct { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->suspend;</PRE>
+<PRE>
+ $error = $record->unsuspend;</PRE>
+<PRE>
+ $error = $record->cancel;</PRE>
+<PRE>
+ %hash = $record->radius;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::svc_acct object represents an account. FS::svc_acct inherits from
+FS::svc_Common. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">svcnum - primary key (assigned automatcially for new accounts)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_username">username</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item__password_%2D_generated_if_blank">_password - generated if blank</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_presence">popnum - Point of presence (see <A HREF=".././FS/svc_acct_pop.html">the FS::svc_acct_pop manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_uid">uid</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_gid">gid</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_finger_%2D_GECOS">finger - GECOS</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_blank">dir - set automatically if blank (and uid is not)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_shell">shell</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_quota_%2D_%28unimplementd%29">quota - (unimplementd)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_slipip_%2D_IP_address">slipip - IP address</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_radius_Radius_Attribute_%2D_Radius%2DAttribute">radius_<EM>Radius_Attribute</EM> - <EM>Radius-Attribute</EM></A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new account. To add the account to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this account to the database. If there is an error, returns the error,
+otherwise returns false.
+<P>The additional fields pkgnum and svcpart (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) should be
+defined. An FS::cust_svc record will be created and inserted.</P>
+<P>If the configuration value (see <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>) shellmachine exists, and the
+username, uid, and dir fields are defined, the <CODE>command(s)</CODE> specified in
+the shellmachine-useradd configuration are exectued on shellmachine via ssh.
+This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
+If the shellmachine-useradd configuration file does not exist,</P>
+<PRE>
+ useradd -d $dir -m -s $shell -u $uid $username</PRE>
+<P>is the default. If the shellmachine-useradd configuration file exists but
+it empty,</P>
+<PRE>
+ cp -pr /etc/skel $dir; chown -R $uid.$gid $dir</PRE>
+<P>is the default instead. Otherwise the contents of the file are treated as
+a double-quoted perl string, with the following variables available:
+$username, $uid, $gid, $dir, and $shell.</P>
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this account from the database. If there is an error, returns the
+error, otherwise returns false.
+<P>The corresponding FS::cust_svc record will be deleted as well.</P>
+<P>If the configuration value (see <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>) shellmachine exists, the
+<CODE>command(s)</CODE> specified in the shellmachine-userdel configuration file are
+executed on shellmachine via ssh. This behavior can be surpressed by setting
+$FS::svc_acct::nossh_hack true. If the shellmachine-userdel configuration
+file does not exist,</P>
+<PRE>
+ userdel $username</PRE>
+<P>is the default. If the shellmachine-userdel configuration file exists but
+is empty,</P>
+<PRE>
+ rm -rf $dir</PRE>
+<P>is the default instead. Otherwise the contents of the file are treated as a
+double-quoted perl string, with the following variables available:
+$username and $dir.</P>
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P>If the configuration value (see <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>) shellmachine exists, and the
+dir field has changed, the <CODE>command(s)</CODE> specified in the shellmachine-usermod
+configuraiton file are executed on shellmachine via ssh. This behavior can
+be surpressed by setting $FS::svc-acct::nossh_hack true. If the
+shellmachine-userdel configuration file does not exist or is empty, :</P>
+<PRE>
+ [ -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
+ )</PRE>
+<P>is executed on shellmachine via ssh. This behaviour can be surpressed by
+setting $FS::svc_acct::nossh_hack true.</P>
+<P></P>
+<DT><STRONG><A NAME="item_suspend">suspend</A></STRONG><BR>
+<DD>
+Suspends this account by prefixing *SUSPENDED* to the password. If there is an
+error, returns the error, otherwise returns false.
+<P>Called by the suspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_unsuspend">unsuspend</A></STRONG><BR>
+<DD>
+Unsuspends this account by removing *SUSPENDED* from the password. If there is
+an error, returns the error, otherwise returns false.
+<P>Called by the unsuspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_cancel">cancel</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the cancel method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P>Sets any fixed values; see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>.</P>
+<P></P>
+<DT><STRONG><A NAME="item_radius">radius</A></STRONG><BR>
+<DD>
+Depriciated, use radius_reply instead.
+<P></P>
+<DT><STRONG><A NAME="item_radius_reply">radius_reply</A></STRONG><BR>
+<DD>
+Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
+reply attributes of this record.
+<P>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.</P>
+<P></P>
+<DT><STRONG><A NAME="item_radius_check">radius_check</A></STRONG><BR>
+<DD>
+Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
+check attributes of this record.
+<P>Accessing RADIUS attributes directly is not supported and will break in the
+future.</P>
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: svc_acct.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The bits which ssh should fork before doing so (or maybe queue jobs for a
+daemon).</P>
+<P>The $recref stuff in sub check should be cleaned up.</P>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/svc_Common.html">the FS::svc_Common manpage</A>, <A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>,
+<A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, <A HREF="../Net/SSH.html">the Net::SSH manpage</A>, <EM>ssh</EM>, <A HREF=".././FS/svc_acct_pop.html">the FS::svc_acct_pop manpage</A>,
+schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::svc_acct_pop - Object methods for svc_acct_pop records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::svc_acct_pop - Object methods for svc_acct_pop records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::svc_acct_pop;</PRE>
+<PRE>
+ $record = new FS::svc_acct_pop \%hash;
+ $record = new FS::svc_acct_pop { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::svc_acct object represents an point of presence. FS::svc_acct_pop
+inherits from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">popnum - primary key (assigned automatically for new accounts)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_city">city</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_state">state</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_ac_%2D_area_code">ac - area code</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_exch_%2D_exchange">exch - exchange</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_loc_%2D_rest_of_number">loc - rest of number</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new point of presence (if only it were that easy!). To add the
+point of presence to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this point of presence to the database. If there is an error, returns the
+error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Removes this point of presence from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: svc_acct_pop.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>It should be renamed to part_pop.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/svc_acct.html">the svc_acct manpage</A>, schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::svc_acct_sm - Object methods for svc_acct_sm records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::svc_acct_sm - Object methods for svc_acct_sm records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::svc_acct_sm;</PRE>
+<PRE>
+ $record = new FS::svc_acct_sm \%hash;
+ $record = new FS::svc_acct_sm { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->suspend;</PRE>
+<PRE>
+ $error = $record->unsuspend;</PRE>
+<PRE>
+ $error = $record->cancel;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::svc_acct object represents a virtual mail alias. FS::svc_acct inherits
+from FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">svcnum - primary key (assigned automatcially for new accounts)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_domain">domsvc - svcnum of the virtual domain (see <A HREF=".././FS/svc_domain.html">the FS::svc_domain manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_account">domuid - uid of the target account (see <A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_domuser_%2D_virtual_username">domuser - virtual username</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new virtual mail alias. To add the virtual mail alias to the
+database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this virtual mail alias to the database. If there is an error, returns
+the error, otherwise returns false.
+<P>The additional fields pkgnum and svcpart (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) should be
+defined. An FS::cust_svc record will be created and inserted.</P>
+<P>If the configuration values (see <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>) shellmachine and qmailmachines
+exist, and domuser is `*' (meaning a catch-all mailbox), the command:</P>
+<PRE>
+ [ -e $dir/.qmail-$qdomain-default ] || {
+ touch $dir/.qmail-$qdomain-default;
+ chown $uid:$gid $dir/.qmail-$qdomain-default;
+ }</PRE>
+<P>is executed on shellmachine via ssh (see <EM>dot-qmail/``EXTENSION ADDRESSES''</EM>).
+This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.</P>
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this virtual mail alias from the database. If there is an error,
+returns the error, otherwise returns false.
+<P>The corresponding FS::cust_svc record will be deleted as well.</P>
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_suspend">suspend</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the suspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_unsuspend">unsuspend</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the unsuspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_cancel">cancel</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the cancel method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P>Sets any fixed values; see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>.</P>
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: svc_acct_sm.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>The remote commands should be configurable.</P>
+<P>The $recref stuff in sub check should be cleaned up.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>, <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>,
+<A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>, <A HREF=".././FS/svc_domain.html">the FS::svc_domain manpage</A>, <A HREF="../Net/SSH.html">the Net::SSH manpage</A>, <EM>ssh</EM>, <EM>dot-qmail</EM>,
+schema.html from the base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::svc_domain - Object methods for svc_domain records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::svc_domain - Object methods for svc_domain records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::svc_domain;</PRE>
+<PRE>
+ $record = new FS::svc_domain \%hash;
+ $record = new FS::svc_domain { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->suspend;</PRE>
+<PRE>
+ $error = $record->unsuspend;</PRE>
+<PRE>
+ $error = $record->cancel;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::svc_domain object represents a domain. FS::svc_domain inherits from
+FS::svc_Common. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_key">svcnum - primary key (assigned automatically for new accounts)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_domain">domain</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new domain. To add the domain to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this domain to the database. If there is an error, returns the error,
+otherwise returns false.
+<P>The additional fields <EM>pkgnum</EM> and <EM>svcpart</EM> (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) should be
+defined. An FS::cust_svc record will be created and inserted.</P>
+<P>The additional field <EM>action</EM> should be set to <EM>N</EM> for new domains or <EM>M</EM>
+for transfers.</P>
+<P>A registration or transfer email will be submitted unless
+$FS::svc_domain::whois_hack is true.</P>
+<P>The additional field <EM>email</EM> can be used to manually set the admin contact
+email address on this email. Otherwise, the svc_acct records for this package
+(see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>) are searched. If there is exactly one svc_acct record
+in the same package, it is automatically used. Otherwise an error is returned.</P>
+<P>If any <EM>soamachine</EM> configuration file exists, an SOA record is added to
+the domain_record table (see <FS::domain_record>).</P>
+<P>If any machines are defined in the <EM>nsmachines</EM> configuration file, NS
+records are added to the domain_record table (see <A HREF=".././FS/domain_record.html">the FS::domain_record manpage</A>).</P>
+<P>If any machines are defined in the <EM>mxmachines</EM> configuration file, MX
+records are added to the domain_record table (see <A HREF=".././FS/domain_record.html">the FS::domain_record manpage</A>).</P>
+<P>Any problems adding FS::domain_record records will emit warnings, but will
+not return errors from this method. If your configuration files are correct
+you shouln't have any problems.</P>
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this domain from the database. If there is an error, returns the
+error, otherwise returns false.
+<P>The corresponding FS::cust_svc record will be deleted as well.</P>
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_suspend">suspend</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the suspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_unsuspend">unsuspend</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the unsuspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_cancel">cancel</A></STRONG><BR>
+<DD>
+Just returns false (no error) for now.
+<P>Called by the cancel method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).</P>
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P>Sets any fixed values; see <A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>.</P>
+<P></P>
+<DT><STRONG><A NAME="item_whois">whois</A></STRONG><BR>
+<DD>
+Returns the Net::Whois::Domain object (see <A HREF="../Net/Whois.html">the Net::Whois manpage</A>) for this domain, or
+undef if the domain is not found in whois.
+<P>(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.)</P>
+<P></P>
+<DT><STRONG><A NAME="item__whois">_whois</A></STRONG><BR>
+<DD>
+Depriciated.
+<P></P>
+<DT><STRONG><A NAME="item_submit_internic">submit_internic</A></STRONG><BR>
+<DD>
+Submits a registration email for this domain.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: svc_domain.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>All BIND/DNS fields should be included (and exported).</P>
+<P>Delete doesn't send a registration template.</P>
+<P>All registries should be supported.</P>
+<P>Should change action to a real field.</P>
+<P>The $recref stuff in sub check should be cleaned up.</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/svc_Common.html">the FS::svc_Common manpage</A>, <A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>,
+<A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, <A HREF="../Net/Whois.html">the Net::Whois manpage</A>, <EM>ssh</EM>,
+<EM>dot-qmail</EM>, schema.html from the base documentation, config.html from the
+base documentation.</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::svc_www - Object methods for svc_www records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+ <LI><A HREF="#history">HISTORY</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::svc_www - Object methods for svc_www records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::svc_www;</PRE>
+<PRE>
+ $record = new FS::svc_www \%hash;
+ $record = new FS::svc_www { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<PRE>
+ $error = $record->suspend;</PRE>
+<PRE>
+ $error = $record->unsuspend;</PRE>
+<PRE>
+ $error = $record->cancel;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::svc_www object represents an web virtual host. FS::svc_www inherits
+from FS::svc_Common. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_svcnum_%2D_primary_key">svcnum - primary key</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_recnum_%2D_DNS_%60A%27_record_corresponding_to_thi">recnum - DNS `A' record corresponding to this web virtual host. (see <A HREF=".././FS/domain_record.html">the FS::domain_record manpage</A>)</A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_account">usersvc - account (see <A HREF=".././FS/svc_acct.html">the FS::svc_acct manpage</A>) corresponding to this web virtual host.</A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Creates a new web virtual host. To add the record to the database, see
+<A HREF="#insert">insert</A>.
+<P>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 <EM>hash</EM> method.</P>
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P>The additional fields pkgnum and svcpart (see <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>) should be
+defined. An FS::cust_svc record will be created and inserted.</P>
+<P>If the configuration values (see <A HREF=".././FS/Conf.html">the FS::Conf manpage</A>) <EM>apachemachine</EM>, and
+<EM>apacheroot</EM> exist, the command:</P>
+<PRE>
+ mkdir $apacheroot/$zone;
+ chown $username $apacheroot/$zone;
+ ln -s $apacheroot/$zone $homedir/$zone</PRE>
+<P><EM>$zone</EM> is the DNS A record pointed to by <EM>recnum</EM>
+<EM>$username</EM> is the username pointed to by <EM>usersvc</EM>
+<EM>$homedir</EM> is that user's home directory</P>
+<P>is executed on <EM>apachemachine</EM> via ssh. This behaviour can be surpressed by
+setting $FS::svc_www::nossh_hack true.</P>
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Delete this record from the database.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_suspend">suspend</A></STRONG><BR>
+<DD>
+Called by the suspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_unsuspend">unsuspend</A></STRONG><BR>
+<DD>
+Called by the unsuspend method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_cancel">cancel</A></STRONG><BR>
+<DD>
+Called by the cancel method of FS::cust_pkg (see <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>).
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: svc_www.html,v 1.1 2001-04-23 12:41:57 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/svc_Common.html">the FS::svc_Common manpage</A>, <A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/domain_record.html">the FS::domain_record manpage</A>, <A HREF=".././FS/cust_svc.html">the FS::cust_svc manpage</A>,
+<A HREF=".././FS/part_svc.html">the FS::part_svc manpage</A>, <A HREF=".././FS/cust_pkg.html">the FS::cust_pkg manpage</A>, schema.html from the base documentation.</P>
+<P>
+<HR>
+<H1><A NAME="history">HISTORY</A></H1>
+<P>$Log: svc_www.html,v $
+<P>Revision 1.1 2001-04-23 12:41:57 ivan
+<P>new API documentation
+<P>
+Revision 1.4 2001/04/22 01:56:15 ivan
+get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)</P>
+<P>Revision 1.3 2000/11/22 23:30:51 ivan
+tyop</P>
+<P>Revision 1.2 2000/03/01 08:13:59 ivan
+compilation bugfixes</P>
+<P>Revision 1.1 2000/02/03 05:16:52 ivan
+beginning of DNS and Apache support</P>
+
+</BODY>
+
+</HTML>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>FS::type_pkgs - Object methods for type_pkgs records</TITLE>
+<LINK REV="made" HREF="mailto:perl@packages.debian.org">
+</HEAD>
+
+<BODY>
+
+<A NAME="__index__"></A>
+<!-- INDEX BEGIN -->
+
+<UL>
+
+ <LI><A HREF="#name">NAME</A></LI>
+ <LI><A HREF="#synopsis">SYNOPSIS</A></LI>
+ <LI><A HREF="#description">DESCRIPTION</A></LI>
+ <LI><A HREF="#methods">METHODS</A></LI>
+ <LI><A HREF="#version">VERSION</A></LI>
+ <LI><A HREF="#bugs">BUGS</A></LI>
+ <LI><A HREF="#see also">SEE ALSO</A></LI>
+</UL>
+<!-- INDEX END -->
+
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>FS::type_pkgs - Object methods for type_pkgs records</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+ use FS::type_pkgs;</PRE>
+<PRE>
+ $record = new FS::type_pkgs \%hash;
+ $record = new FS::type_pkgs { 'column' => 'value' };</PRE>
+<PRE>
+ $error = $record->insert;</PRE>
+<PRE>
+ $error = $new_record->replace($old_record);</PRE>
+<PRE>
+ $error = $record->delete;</PRE>
+<PRE>
+ $error = $record->check;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>An FS::type_pkgs record links an agent type (see <A HREF=".././FS/agent_type.html">the FS::agent_type manpage</A>) to a
+billing item definition (see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A>). FS::type_pkgs inherits from
+FS::Record. The following fields are currently supported:</P>
+<DL>
+<DT><STRONG><A NAME="item_typenum_%2D_Agent_type%2C_see_FS%3A%3Aagent_type">typenum - Agent type, see <A HREF=".././FS/agent_type.html">the FS::agent_type manpage</A></A></STRONG><BR>
+<DD>
+<DT><STRONG><A NAME="item_pkgpart_%2D_Billing_item_definition%2C_see_FS%3A%3">pkgpart - Billing item definition, see <A HREF=".././FS/part_pkg.html">the FS::part_pkg manpage</A></A></STRONG><BR>
+<DD>
+</DL>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new">new HASHREF</A></STRONG><BR>
+<DD>
+Create a new record. To add the record to the database, see <A HREF="#insert">insert</A>.
+<P></P>
+<DT><STRONG><A NAME="item_insert">insert</A></STRONG><BR>
+<DD>
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_delete">delete</A></STRONG><BR>
+<DD>
+Deletes this record from the database. If there is an error, returns the
+error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_replace_OLD_RECORD">replace OLD_RECORD</A></STRONG><BR>
+<DD>
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+<P></P>
+<DT><STRONG><A NAME="item_check">check</A></STRONG><BR>
+<DD>
+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.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="version">VERSION</A></H1>
+<P>$Id: type_pkgs.html,v 1.3 2001-04-23 12:40:31 ivan Exp $</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><A HREF=".././FS/Record.html">the FS::Record manpage</A>, <A HREF=".././FS/agent_type.html">the FS::agent_type manpage</A>, <A HREF="../FS/part_pkgs.html">the FS::part_pkgs manpage</A>, schema.html from the base
+documentation.</P>
+
+</BODY>
+
+</HTML>
--- /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>PostgreSQL notes</title>
+</head>
+<body>
+ <h1>PostgreSQL notes</h1>
+<p>
+PostgreSQL ships by default with a maximum of 31 character column names. If
+you use arbitrary RADIUS attributes longer than 9 characters, fs-setup will
+fail with `duplicate column' errors (in the part_svc table).
+Solution: use a different database
+engine, or recompile PostgreSQL with 64 character column names.
+</p>
+Future versions of Freeside will keep all column names under 31 characters to
+avoid this problem.
+</p>
+<p>
+( I've personally been unable to get PostgreSQL working with larger column names,
+though the process does look like it should be straightforward. If anyone is
+interested in assisting me with this, please get in touch.
+ -Ivan <a href="mailto:ivan@sisd.com"><ivan@sisd.com</a>> )
+</p>
+</body>
+
--- /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. Declarations that a customer owes you money. The specific charges are itemized in <a href="#cust_billl_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
+ </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> 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">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
+ </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>titlenum - <a href="#part_title">title</a>
+ <li>first - name
+ <li>middle - 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>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_invoice">cust_main_invoice</a> - Invoice destinations for email invoices
+ <ul>
+ <li>destnum - primary key
+ <li>custnum - <a href="#cust_main">customer</a>
+ <li>dest - Invoice destination: If numeric, a <a href="#svc_acct">svcnum</a>, if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)
+ </ul>
+ <li><a name="cust_main_county">cust_main_county</a> - Tax rates
+ <ul>
+ <li>taxnum - primary key
+ <li>state
+ <li>county
+ <li>country
+ <li>tax - % rate
+ </ul>
+ <li><a name="cust_pay">cust_pay</a> - Payments. Money being transferred from a customer.
+ <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. 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>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="nas">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">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 - primary key
+ <li>referral - 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="part_title">part_title</a> - Personal titles
+ <ul>
+ <li>titlenum - primary key
+ <li>title - personal title (`Dr.' or `Mr.')
+ </ul>
+ <li><a name="pkg_svc">pkg_svc</a>
+ <ul>
+ <li>pkgpart - <a href="#part_pkg">Package definition</a>
+ <li>svcpart - <a href="#part_svc">Service definition</a>
+ <li>quantity - quantity of this service that this package includes
+ </ul>
+ <li><a name="port">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">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">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">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
+ <li>loc - rest of number
+ </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="domain_record">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">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">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>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://www.perl.com/CPAN/modules/by-module/Text/">Text::Template</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>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 following variables available:
+ <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
+ </ul>
+ (an example file is included as <b>fs_signup/ieak.template</b>)
+ <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 following variables available:
+ <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
+ </ul>
+ (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 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.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.4</title>
+</head>
+<body>
+<h1>Upgrading to 1.1.4 from 1.1.x</h1>
+<ul>
+ <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <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
+<head>
+ <title>Upgrading to 1.2.x</title>
+</head>
+<body>
+<h1>Upgrading to 1.2.x from 1.1.x</h1>
+<ul>
+ <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
+ <li>If migrating from less than 1.1.4, see these <a href="upgrade2.html">instructions</a> first.
+ <li>Back up your data and current Freeside installation.
+ <li>Install the Perl module <a href="http://www.perl.com/CPAN/modules/by-module/String/">String-Approx</a>
+ <li><a href="config.html">Configuration file</a> location has changed!
+ <li>Move /var/spool/freeside/dbdef.<i>datasrc</i> to /usr/local/etc/freeside/dbdef.<i>datasrc</i>.
+ <li>Move /var/spool/freeside/counters to /usr/local/etc/freeside/counters.<i>datasrc</i>.
+ <li>Move /var/spool/freeside/export to /usr/local/etc/freeside/export.<i>datasrc</i>.
+ <li>Apply the following changes to your database:
+<pre>
+<!-- ALTER TABLE cust_main ADD middle varchar(80) NULL;
+ALTER TABLE cust_main ADD titlenum int NULL;
+-->ALTER TABLE cust_main CHANGE state state varchar(80) NULL;
+ALTER TABLE cust_main_county CHANGE state state varchar(80) NULL;
+ALTER TABLE cust_main_county ADD country char(2);
+ALTER TABLE cust_main CHANGE paydate paydate varchar(10);
+UPDATE cust_main SET country = "US" where country IS NULL OR country = '';
+UPDATE cust_main_county SET country = "US" where country IS NULL OR country = "";
+<!--CREATE TABLE part_title (
+ titlenum int NOT NULL,
+ title varchar(80) NOT NULL,
+ PRIMARY KEY (titlenum)
+);
+-->CREATE TABLE cust_main_invoice (
+ destnum int NOT NULL,
+ custnum int NOT NULL,
+ dest varchar(80) NOT NULL,
+ PRIMARY KEY (destnum),
+ INDEX ( custnum )
+);
+</pre>
+ <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly.
+ <li>Copy or symlink htdocs and site_perl to the new copies.
+</body>
--- /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
+#!/usr/bin/perl -Tw
+#
+# $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $
+#
+# ivan@sisd.com 97-dec-12
+#
+# Changes to allow page to work at a relative position in server
+# Changed 'type' to 'atype' because Pg6.3 reserves the type word
+# bmccane@maxbaud.net 98-apr-3
+#
+# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: agent.cgi,v $
+# Revision 1.7 1999-04-07 11:27:50 ivan
+# avoid perl's silly arguement not numeric error
+#
+# Revision 1.6 1999/01/25 12:09:50 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:31 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:21 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 06:16:57 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/23 07:52:08 ivan
+# *** empty log message ***
+#
+
+use strict;
+use vars qw ( $cgi $agent $action $hashref $p $agent_type );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header menubar popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::agent;
+use FS::agent_type;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $agent = new FS::agent ( {
+ map { $_, scalar($cgi->param($_)) } fields('agent')
+ } );
+} elsif ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $agent = qsearchs( 'agent', { 'agentnum' => $1 } );
+} else { #adding
+ $agent = new FS::agent {};
+}
+$action = $agent->agentnum ? 'Edit' : 'Add';
+$hashref = $agent->hashref;
+
+$p = popurl(2);
+
+print $cgi->header( '-expires' => 'now' ), header("$action Agent", menubar(
+ 'Main Menu' => $p,
+ 'View all agents' => $p. 'browse/agent.cgi',
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/agent.cgi" METHOD=POST>',
+ qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
+ "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
+
+print <<END;
+<PRE>
+Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}">
+Agent type <SELECT NAME="typenum" SIZE=1>
+END
+
+foreach $agent_type (qsearch('agent_type',{})) {
+ print "<OPTION VALUE=". $agent_type->typenum;
+ print " SELECTED"
+ if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum );
+ print ">", $agent_type->getfield('typenum'), ": ",
+ $agent_type->getfield('atype'),"\n";
+}
+
+print <<END;
+</SELECT>
+Frequency (unimplemented) <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
+Program (unimplemented) <INPUT TYPE="text" NAME="prog" VALUE="$hashref->{prog}">
+</PRE>
+END
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{agentnum} ? "Apply changes" : "Add agent",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: agent_type.cgi,v 1.11 1999-04-07 11:19:21 ivan Exp $
+#
+# agent_type.cgi: Add/Edit agent type (output form)
+#
+# ivan@sisd.com 97-dec-10
+#
+# Changes to allow page to work at a relative position in server
+# Changed 'type' to 'atype' because Pg6.3 reserves the type word
+# bmccane@maxbaud.net 98-apr-3
+#
+# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: agent_type.cgi,v $
+# Revision 1.11 1999-04-07 11:19:21 ivan
+# silly HTML typo
+#
+# Revision 1.10 1999/01/25 12:09:51 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.9 1999/01/19 05:13:32 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.8 1999/01/18 09:41:22 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.7 1999/01/18 09:22:29 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.6 1998/12/17 06:16:58 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.5 1998/11/21 07:58:27 ivan
+# package names link to them
+#
+# Revision 1.4 1998/11/21 07:45:19 ivan
+# visual, use FS::table_name when doing qsearch('table_name')
+#
+# Revision 1.3 1998/11/15 11:20:12 ivan
+# s/CGI-Base/CGI.pm/ causes s/QUERY_STRING/keywords/;
+#
+# Revision 1.2 1998/11/13 09:56:46 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
+
+use strict;
+use vars qw( $cgi $agent_type $action $hashref $p $part_pkg );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::agent_type;
+use FS::CGI qw(header menubar popurl);
+use FS::agent_type;
+use FS::part_pkg;
+use FS::type_pkgs;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $agent_type = new FS::agent_type ( {
+ map { $_, scalar($cgi->param($_)) } fields('agent')
+ } );
+} elsif ( $cgi->keywords ) { #editing
+ my( $query ) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $agent_type=qsearchs('agent_type',{'typenum'=>$1});
+} else { #adding
+ $agent_type = new FS::agent_type {};
+}
+$action = $agent_type->typenum ? 'Edit' : 'Add';
+$hashref = $agent_type->hashref;
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header("$action Agent Type", menubar(
+ 'Main Menu' => "$p",
+ 'View all agent types' => "${p}browse/agent_type.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/agent_type.cgi" METHOD=POST>',
+ qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
+ "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)";
+
+print <<END;
+<BR><BR>Agent Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}">
+<BR><BR>Select which packages agents of this type may sell to customers<BR>
+END
+
+foreach $part_pkg ( qsearch('part_pkg',{}) ) {
+ print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
+ $part_pkg->getfield('pkgpart'), qq!" !,
+ # ( 'CHECKED 'x scalar(
+ qsearchs('type_pkgs',{
+ 'typenum' => $agent_type->getfield('typenum'),
+ 'pkgpart' => $part_pkg->getfield('pkgpart'),
+ })
+ ? 'CHECKED '
+ : '',
+ qq!VALUE="ON"> !,
+ qq!<A HREF="${p}edit/part_pkg.cgi?!, $part_pkg->pkgpart,
+ '">', $part_pkg->getfield('pkg'), '</A>',
+ ;
+}
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{typenum} ? "Apply changes" : "Add agent type",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
#!/usr/bin/perl -Tw
#
-# cust_credit.cgi: Add a credit (output form)
+# $Id: cust_credit.cgi,v 1.7 1999-02-28 00:03:33 ivan Exp $
#
# Usage: cust_credit.cgi custnum [ -paybatch ]
# http://server.name/path/cust_credit?custnum [ -paybatch ]
#
-# Note: Should be run setuid root as user nobody.
-#
# some hooks in here for modifications as well as additions, but needs (lots) more work.
# also see process/cust_credit.cgi, the script that processes the form.
#
# ivan@voicenet.com 97-apr-21
#
# rewrite ivan@sisd.com 98-mar-16
+#
+# $Log: cust_credit.cgi,v $
+# Revision 1.7 1999-02-28 00:03:33 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/01/25 12:09:52 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:33 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:23 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/23 02:26:06 ivan
+# *** empty log message ***
+#
+# Revision 1.2 1998/12/17 06:16:59 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
+use vars qw( $cgi $query $custnum $otaker $p1 $crednum $_date $amount $reason );
use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); #CGI module
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw(header popurl);
+use FS::Record qw(fields);
+#use FS::cust_credit;
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-
-#untaint otaker
-my($otaker)=getotaker;
-
-SendHeaders(); # one guess.
+if ( $cgi->param('error') ) {
+ #$cust_credit = new FS::cust_credit ( {
+ # map { $_, scalar($cgi->param($_)) } fields('cust_credit')
+ #} );
+ $custnum = $cgi->param('custnum');
+ $amount = $cgi->param('amount');
+ #$refund = $cgi->param('refund');
+ $reason = $cgi->param('reason');
+} else {
+ ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $custnum = $1;
+ $amount = '';
+ #$refund = 'yes';
+ $reason = '';
+}
+$_date = time;
+
+$otaker = getotaker;
+
+$p1 = popurl(1);
+
+print $cgi->header( '-expires' => 'now' ), header("Post Credit", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
print <<END;
-<HTML>
- <HEAD>
- <TITLE>Post Credit</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Post Credit</H1>
- </CENTER>
- <FORM ACTION="process/cust_credit.cgi" METHOD=POST>
- <HR><PRE>
+ <FORM ACTION="${p1}process/cust_credit.cgi" METHOD=POST>
+ <PRE>
END
-#crednum
-my($crednum)="";
+$crednum = "";
print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!;
-#custnum
print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
-#paybatch
print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
-#date
-my($date)=time;
-print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
+print qq!\nDate: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="">!;
-#amount
-my($amount)='';
print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
+print qq!<INPUT TYPE="hidden" NAME="credited" VALUE="">!;
-#refund?
-#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">Also post refund!;
+#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="$refund">Also post refund!;
-#otaker (hidden)
print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!;
-#reason
-my($reason)='';
print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!;
print <<END;
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main.cgi,v 1.29 2001-05-23 13:47:07 ivan Exp $
+#
+# Usage: cust_main.cgi custnum
+# http://server.name/path/cust_main.cgi?custnum
+#
+# ivan@voicenet.com 96-nov-29 -> 96-dec-04
+#
+# Blank custnum for new customer.
+# ivan@voicenet.com 96-dec-16
+#
+# referral defaults to blank, to force people to pick something
+# ivan@voicenet.com 97-jun-4
+#
+# rewrote for new API
+# ivan@voicenet.com 97-jul-28
+#
+# new customer is null, not '#'
+# otaker gotten from &getotaker instead of $ENV{REMOTE_USER}
+# ivan@sisd.com 97-nov-12
+#
+# cgisuidsetup($cgi);
+# no need for old_ fields.
+# now state+county is a select field (took out PA hack)
+# used autoloaded $cust_main->field methods
+# ivan@sisd.com 97-dec-17
+#
+# fixed quoting problems ivan@sisd.com 98-feb-23
+#
+# paydate sql update ivan@sisd.com 98-mar-5
+#
+# Changes to allow page to work at a relative position in server
+# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
+# Added test for paydate in mm-dd-yyyy format for Pg6.3 default format
+# bmccane@maxbaud.net 98-apr-3
+#
+# fixed one missed day->daytime ivan@sisd.com 98-jul-13
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.29 2001-05-23 13:47:07 ivan
+# bugfix for defaultcountry
+#
+# Revision 1.28 2000/12/26 23:51:40 ivan
+# statedefault & referraldefault config files
+#
+# Revision 1.27 2000/12/03 13:45:15 ivan
+# patch from Jason Spence <thalakan@frys.com>: admin.html doc, autocapgen
+#
+# Revision 1.26 2000/06/27 12:15:50 ivan
+# i18n
+#
+# Revision 1.25 2000/03/02 08:09:38 ivan
+# still need to allow blank expiration dates
+#
+# Revision 1.24 2000/01/30 06:54:50 ivan
+# credit card expiration dates not sticky bug fixed?
+#
+# Revision 1.23 2000/01/27 00:53:14 ivan
+# 5.004_04 workaround
+#
+# Revision 1.22 1999/12/17 02:33:23 ivan
+# argh
+#
+# Revision 1.21 1999/08/23 07:40:38 ivan
+# missing </TD> flag
+#
+# Revision 1.20 1999/08/23 07:08:11 ivan
+# no CGI::Switch for now
+#
+# Revision 1.19 1999/08/21 02:14:25 ivan
+# better error message for no agents
+#
+# Revision 1.18 1999/08/11 15:38:33 ivan
+# fix for perl 5.004_04
+#
+# Revision 1.17 1999/08/10 11:15:45 ivan
+# corrected a misleading comment
+#
+# Revision 1.15 1999/04/14 13:14:54 ivan
+# configuration option to edit referrals of existing customers
+#
+# Revision 1.14 1999/04/14 07:47:53 ivan
+# i18n fixes
+#
+# Revision 1.13 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.12 1999/04/06 11:16:16 ivan
+# give a meaningful error message if you try to create a customer before you've
+# created an agent
+#
+# Revision 1.11 1999/03/25 13:55:10 ivan
+# one-screen new customer entry (including package and service) for simple
+# packages with one svc_acct service
+#
+# Revision 1.10 1999/02/28 00:03:34 ivan
+# removed misleading comments
+#
+# Revision 1.9 1999/02/23 08:09:20 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.8 1999/01/25 12:09:53 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.7 1999/01/19 05:13:34 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:24 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1999/01/18 09:22:30 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.4 1998/12/23 08:08:15 ivan
+# fix typo
+#
+# Revision 1.3 1998/12/17 06:17:00 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+
+use strict;
+use vars qw( $cgi $custnum $action $cust_main $p1 @agents $agentnum
+ $last $first $ss $company $address1 $address2 $city $zip
+ $daytime $night $fax @invoicing_list $invoicing_list $payinfo
+ $payname %payby %paybychecked $refnum $otaker $r );
+use vars qw ( $conf $pkgpart $username $password $popnum $ulen $ulen2 );
+#use CGI::Switch;
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup getotaker);
+#use FS::Record qw(qsearch qsearchs fields);
+use FS::Record qw(qsearch qsearchs fields dbdef);
+use FS::CGI qw(header popurl itable table);
+use FS::cust_main;
+use FS::agent;
+use FS::part_referral;
+use FS::cust_main_county;
+
+ #for misplaced logic below
+ use FS::part_pkg;
+
+ #for false laziness below
+ use FS::svc_acct_pop;
+
+ #for (other) false laziness below
+ use FS::agent;
+ use FS::type_pkgs;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+
+#get record
+
+if ( $cgi->param('error') ) {
+ $cust_main = new FS::cust_main ( {
+ map { $_, scalar($cgi->param($_)) } fields('cust_main')
+ } );
+ $custnum = $cust_main->custnum;
+ $pkgpart = $cgi->param('pkgpart_svcpart') || '';
+ if ( $pkgpart =~ /^(\d+)_/ ) {
+ $pkgpart = $1;
+ } else {
+ $pkgpart = '';
+ }
+ $username = $cgi->param('username');
+ $password = $cgi->param('_password');
+ $popnum = $cgi->param('popnum');
+} elsif ( $cgi->keywords ) { #editing
+ my( $query ) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $custnum=$1;
+ $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
+ $pkgpart = 0;
+ $username = '';
+ $password = '';
+ $popnum = 0;
+} else {
+ $custnum='';
+ $cust_main = new FS::cust_main ( {} );
+ $cust_main->setfield('otaker',&getotaker);
+ $pkgpart = 0;
+ $username = '';
+ $password = '';
+ $popnum = 0;
+}
+$action = $custnum ? 'Edit' : 'Add';
+
+# top
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Customer $action", '');
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+# JRS: Javascript to set up the form for us
+ if ( $conf->exists('autocapnames') ) {
+ print <<END;
+<SCRIPT language="Javascript"><!--
+
+function capName(name) {
+ var temp = new String();
+ var n = name.toString();
+
+// Handle "Mc", "Mac", "Von", "Van", etc...
+
+ if(n.substr(0,2).toLowerCase() == "mc") {
+ temp += "Mc";
+ temp += n.charAt(2).toUpperCase();
+ temp += n.substr(3).toLowerCase();
+ return temp;
+ }
+
+ if(n.substr(0,3).toLowerCase() == "mac") {
+ temp += "Mac";
+ temp += n.charAt(3).toUpperCase();
+ temp += n.substr(4).toLowerCase();
+ return temp;
+ }
+ if(n.substr(0,3).toLowerCase() == "von") {
+ temp += "Von";
+ temp += n.charAt(3).toUpperCase();
+ temp += n.substr(4).toLowerCase();
+ return temp;
+ }
+ if(n.substr(0,3).toLowerCase() == "van") {
+ temp += "Van";
+ temp += n.charAt(3).toUpperCase();
+ temp += n.substr(4).toLowerCase();
+ return temp;
+ }
+ temp += n.charAt(0).toUpperCase();
+ temp += n.substr(1).toLowerCase();
+ return temp;
+}
+
+//-->
+</SCRIPT>
+END
+}
+
+print qq!<FORM ACTION="${p1}process/cust_main.cgi" METHOD=POST NAME="form1">!,
+ qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
+ qq!Customer # !, ( $custnum ? $custnum : " (NEW)" ),
+
+;
+
+# agent
+
+$r = qq!<font color="#ff0000">*</font>!;
+
+@agents = qsearch( 'agent', {} );
+#die "No agents created!" unless @agents;
+die "You have not created any agents. You must create at least one agent before adding a customer. Go to ". popurl(2). "browse/agent.cgi and create one or more agents." unless @agents;
+$agentnum = $cust_main->agentnum || $agents[0]->agentnum; #default to first
+if ( scalar(@agents) == 1 ) {
+ print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$agentnum">!;
+} else {
+ print qq!<BR><BR>${r}Agent <SELECT NAME="agentnum" SIZE="1">!;
+ my $agent;
+ foreach $agent (sort {
+ $a->agent cmp $b->agent;
+ } @agents) {
+ print '<OPTION VALUE="', $agent->agentnum, '"',
+ " SELECTED"x($agent->agentnum==$agentnum),
+ ">", $agent->agentnum,": ", $agent->agent;
+ }
+ print "</SELECT>";
+}
+
+#referral
+
+$refnum = $cust_main->refnum || $conf->config('referraldefault') || 0;
+if ( $custnum && ! $conf->exists('editreferrals') ) {
+ print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
+} else {
+ my(@referrals) = qsearch('part_referral',{});
+ if ( scalar(@referrals) == 1 ) {
+ $refnum ||= $referrals[0]->refnum;
+ print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$refnum">!;
+ } else {
+ print qq!<BR><BR>${r}Referral <SELECT NAME="refnum" SIZE="1">!;
+ print "<OPTION> " unless $refnum;
+ my($referral);
+ foreach $referral (sort {
+ $a->refnum <=> $b->refnum;
+ } @referrals) {
+ print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
+ ">", $referral->refnum, ": ", $referral->referral;
+ }
+ print "</SELECT>";
+ }
+}
+
+
+# contact info
+
+($last,$first,$ss,$company,$address1,$address2,$city,$zip)=(
+ $cust_main->last,
+ $cust_main->first,
+ $cust_main->ss,
+ $cust_main->company,
+ $cust_main->address1,
+ $cust_main->address2,
+ $cust_main->city,
+ $cust_main->zip,
+);
+
+print "<BR><BR>Contact information", &itable("#c0c0c0"), <<END;
+<TR><TH ALIGN="right">${r}Contact name<BR>(last, first)</TH><TD COLSPAN=3>
+END
+
+if ( $conf->exists('autocapnames') ) {
+ print <<END;
+<INPUT TYPE="text" NAME="last" VALUE="$last" onChange="updateUsername();">,
+<INPUT TYPE="text" NAME="first" VALUE="$first" onChange="updateUsername();">
+END
+} else {
+ print <<END;
+<INPUT TYPE="text" NAME="last" VALUE="$last">,
+<INPUT TYPE="text" NAME="first" VALUE="$first">
+END
+}
+
+print <<END;
+</TD><TD ALIGN="right">SS#</TD><TD><INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11></TD></TR>
+<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="company" VALUE="$company" SIZE=70></TD></TR>
+<TR><TH ALIGN="right">${r}Address</TH><TD COLSPAN=5><INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=70></TD></TR>
+<TR><TD ALIGN="right"> </TD><TD COLSPAN=5><INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=70></TD></TR>
+<TR><TH ALIGN="right">${r}City</TH><TD><INPUT TYPE="text" NAME="city" VALUE="$city"></TD><TH ALIGN="right">${r}State/Country</TH><TD><SELECT NAME="state" SIZE="1">
+END
+
+$cust_main->country( $conf->config('countrydefault') || 'US' )
+ unless $cust_main->country;
+$cust_main->state( $conf->config('statedefault') || 'CA' )
+ unless $cust_main->state || $cust_main->country ne 'US';
+foreach ( qsearch('cust_main_county',{}) ) {
+ print "<OPTION";
+ print " SELECTED" if ( $cust_main->state eq $_->state
+ && $cust_main->county eq $_->county
+ && $cust_main->country eq $_->country
+ );
+ print ">",$_->state;
+ print " (",$_->county,")" if $_->county;
+ print " / ", $_->country;
+}
+print qq!</SELECT></TD><TH>${r}Zip</TH><TD><INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10></TD></TR>!;
+
+($daytime,$night,$fax)=(
+ $cust_main->daytime,
+ $cust_main->night,
+ $cust_main->fax,
+);
+
+print <<END;
+<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18></TD></TR>
+<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18></TD></TR>
+<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5><INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12></TD></TR>
+END
+
+print "</TABLE>$r required fields<BR>";
+
+# billing info
+
+sub expselect {
+ my $prefix = shift;
+ my( $m, $y ) = (0, 0);
+ if ( scalar(@_) ) {
+ my $date = shift || '01-2000';
+ if ( $date =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format
+ ( $m, $y ) = ( $2, $1 );
+ } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
+ ( $m, $y ) = ( $1, $3 );
+ } else {
+ die "unrecognized expiration date format: $date";
+ }
+ }
+
+ my $return = qq!<SELECT NAME="$prefix!. qq!_month" SIZE="1">!;
+ for ( 1 .. 12 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $m;
+ $return .= ">$_";
+ }
+ $return .= qq!</SELECT>/<SELECT NAME="$prefix!. qq!_year" SIZE="1">!;
+ for ( 2001 .. 2037 ) {
+ $return .= "<OPTION";
+ $return .= " SELECTED" if $_ == $y;
+ $return .= ">$_";
+ }
+ $return .= "</SELECT>";
+
+ $return;
+}
+
+print "<BR>Billing information", &itable("#c0c0c0"),
+ qq!<TR><TD><INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!;
+print qq! CHECKED! if $cust_main->tax eq "Y";
+print qq!>Tax Exempt</TD></TR>!;
+print qq!<TR><TD><INPUT TYPE="checkbox" NAME="invoicing_list_POST" VALUE="POST"!;
+@invoicing_list = $cust_main->invoicing_list;
+print qq! CHECKED!
+ if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list;
+print qq!>Postal mail invoice</TD></TR>!;
+$invoicing_list = join(', ', grep { $_ ne 'POST' } @invoicing_list );
+print qq!<TR><TD>Email invoice <INPUT TYPE="text" NAME="invoicing_list" VALUE="$invoicing_list"></TD></TR>!;
+
+print "<TR><TD>Billing type</TD></TR>",
+ "</TABLE>",
+ &table("#c0c0c0"), "<TR>";
+
+($payinfo, $payname)=(
+ $cust_main->payinfo,
+ $cust_main->payname,
+);
+
+%payby = (
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD"). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="">!,
+ 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE=""><BR>${r}Exp !. expselect("BILL", "12-2037"). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="Accounts Payable">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE=""><BR>${r}Exp !. expselect("COMP"),
+);
+%paybychecked = (
+ 'CARD' => qq!Credit card<BR>${r}<INPUT TYPE="text" NAME="CARD_payinfo" VALUE="$payinfo" MAXLENGTH=19><BR>${r}Exp !. expselect("CARD", $cust_main->paydate). qq!<BR>${r}Name on card<BR><INPUT TYPE="text" NAME="CARD_payname" VALUE="$payname">!,
+ 'BILL' => qq!Billing<BR>P.O. <INPUT TYPE="text" NAME="BILL_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("BILL", $cust_main->paydate). qq!<BR>${r}Attention<BR><INPUT TYPE="text" NAME="BILL_payname" VALUE="$payname">!,
+ 'COMP' => qq!Complimentary<BR>${r}Approved by<INPUT TYPE="text" NAME="COMP_payinfo" VALUE="$payinfo"><BR>${r}Exp !. expselect("COMP", $cust_main->paydate),
+);
+for (qw(CARD BILL COMP)) {
+ print qq!<TD VALIGN=TOP><INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
+ if ($cust_main->payby eq "$_") {
+ print qq! CHECKED> $paybychecked{$_}</TD>!;
+ } else {
+ print qq!> $payby{$_}</TD>!;
+ }
+}
+
+print "</TR></TABLE>$r required fields for each billing type";
+
+unless ( $custnum ) {
+ # pry the wrong place for this logic. also pretty expensive
+ #use FS::part_pkg;
+
+ #false laziness, copied from FS::cust_pkg::order
+ my $pkgpart;
+ if ( scalar(@agents) == 1 ) {
+ # $pkgpart->{PKGPART} is true iff $custnum may purchase $pkgpart
+ my($agent)=qsearchs('agent',{'agentnum'=> $agentnum });
+ $pkgpart = $agent->pkgpart_hashref;
+ } else {
+ #can't know (agent not chosen), so, allow all
+ my %typenum;
+ foreach my $agent ( @agents ) {
+ next if $typenum{$agent->typenum}++;
+ #fixed in 5.004_05 #$pkgpart->{$_}++ foreach keys %{ $agent->pkgpart_hashref }
+ foreach ( keys %{ $agent->pkgpart_hashref } ) { $pkgpart->{$_}++; } #5.004_04 workaround
+ }
+ }
+ #eslaf
+
+ my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } }
+ qsearch( 'part_pkg', {} );
+
+ if ( @part_pkg ) {
+
+ print "<BR><BR>First package", &itable("#c0c0c0"),
+ qq!<TR><TD COLSPAN=2><SELECT NAME="pkgpart_svcpart">!;
+
+ print qq!<OPTION VALUE="">(none)!;
+
+ foreach my $part_pkg ( @part_pkg ) {
+ print qq!<OPTION VALUE="!,
+# $part_pkg->pkgpart. "_". $pkgpart{ $part_pkg->pkgpart }, '"';
+ $part_pkg->pkgpart. "_". $part_pkg->svcpart, '"';
+ print " SELECTED" if $pkgpart && ( $part_pkg->pkgpart == $pkgpart );
+ print ">", $part_pkg->pkg, " - ", $part_pkg->comment;
+ }
+ print "</SELECT></TD></TR>";
+
+ #false laziness: (mostly) copied from edit/svc_acct.cgi
+ #$ulen = $svc_acct->dbdef_table->column('username')->length;
+ $ulen = dbdef->table('svc_acct')->column('username')->length;
+ $ulen2 = $ulen+2;
+ print <<END;
+<TR><TD ALIGN="right">Username</TD>
+<TD><INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen></TD></TR>
+<TR><TD ALIGN="right">Password</TD>
+<TD><INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
+(blank to generate)</TD></TR>
+END
+ print qq!<TR><TD ALIGN="right">POP</TD><TD><SELECT NAME="popnum" SIZE=1><OPTION> !;
+ my($svc_acct_pop);
+ foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
+ print qq!<OPTION VALUE="!, $svc_acct_pop->popnum, '"',
+ ( $popnum && $svc_acct_pop->popnum == $popnum ) ? ' SELECTED' : '', ">",
+ $svc_acct_pop->popnum, ": ",
+ $svc_acct_pop->city, ", ",
+ $svc_acct_pop->state,
+ " (", $svc_acct_pop->ac, ")/",
+ $svc_acct_pop->exch, "\n"
+ ;
+ }
+ print "</SELECT></TD></TR></TABLE>";
+ }
+}
+
+$otaker = $cust_main->otaker;
+print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!,
+ qq!<BR><BR><INPUT TYPE="submit" VALUE="!,
+ $custnum ? "Apply Changes" : "Add Customer", qq!">!,
+ "</FORM></BODY></HTML>",
+;
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $
+#
+# ivan@sisd.com 97-dec-16
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county-expand.cgi,v $
+# Revision 1.6 1999-01-25 12:09:54 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:35 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:25 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 06:17:01 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/18 09:01:38 ivan
+# i18n! i18n!
+#
+
+use strict;
+use vars qw( $cgi $taxnum $cust_main_county $p1 $delim $expansion );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar popurl);
+use FS::cust_main_county;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $taxnum = $cgi->param('taxnum');
+ $delim = $cgi->param('delim');
+ $expansion = $cgi->param('expansion');
+} else {
+ my ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/
+ or die "Illegal taxnum!";
+ $taxnum = $1;
+ $delim = 'n';
+ $expansion = '';
+}
+
+$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum});
+die "Can't expand entry!" if $cust_main_county->getfield('county');
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Tax Rate (expand)", menubar(
+ 'Main Menu' => popurl(2),
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print <<END;
+ <FORM ACTION="${p1}process/cust_main_county-expand.cgi" METHOD=POST>
+ <INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum">
+ Separate by
+END
+print '<INPUT TYPE="radio" NAME="delim" VALUE="n"';
+print ' CHECKED' if $delim eq 'n';
+print '>line (rumor has it broken on some browsers) or',
+ '<INPUT TYPE="radio" NAME="delim" VALUE="s"';
+print ' CHECKED' if $delim eq 's';
+print '>whitespace.';
+print <<END;
+ <BR><INPUT TYPE="submit" VALUE="Submit">
+ <BR><TEXTAREA NAME="expansion" ROWS=100>$expansion</TEXTAREA>
+ </FORM>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $
+#
+# ivan@sisd.com 97-dec-13-16
+#
+# Changes to allow page to work at a relative position in server
+# Changed tax field to accept 6 chars (MO uses 6.1%)
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county.cgi,v $
+# Revision 1.8 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.7 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.6 1999/01/25 12:09:55 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:36 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:26 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 06:17:02 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/18 09:01:39 ivan
+# i18n! i18n!
+#
+
+use strict;
+use vars qw( $cgi $cust_main_county );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar popurl table);
+use FS::cust_main_county;
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+print $cgi->header( '-expires' => 'now' ), header("Edit tax rates", menubar(
+ 'Main Menu' => popurl(2),
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="!, popurl(1),
+ qq!process/cust_main_county.cgi" METHOD=POST>!, &table(), <<END;
+ <TR>
+ <TH><FONT SIZE=-1>Country</FONT></TH>
+ <TH><FONT SIZE=-1>State</FONT></TH>
+ <TH>County</TH>
+ <TH><FONT SIZE=-1>Tax</FONT></TH>
+ </TR>
+END
+
+foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
+ my($hashref)=$cust_main_county->hashref;
+ print <<END;
+ <TR>
+ <TD>$hashref->{country}</TD>
+END
+
+ print "<TD>", $hashref->{state}
+ ? $hashref->{state}
+ : '(ALL)'
+ , "</TD>";
+
+ print "<TD>", $hashref->{county}
+ ? $hashref->{county}
+ : '(ALL)'
+ , "</TD>";
+
+ print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
+ qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD></TR>!;
+END
+
+}
+
+print <<END;
+ </TABLE>
+ <INPUT TYPE="submit" VALUE="Apply changes">
+ </FORM>
+ </CENTER>
+ </BODY>
+</HTML>
+END
+
#!/usr/bin/perl -Tw
#
-# cust_pay.cgi: Add a payment (output form)
+# $Id: cust_pay.cgi,v 1.6 1999-02-28 00:03:35 ivan Exp $
#
# Usage: cust_pay.cgi invnum
# http://server.name/path/cust_pay.cgi?invnum
#
-# Note: Should be run setuid as user nobody.
-#
# some hooks for modifications as well as additions, but needs work.
#
# ivan@voicenet.com 96-dec-11
#
# rewrite ivan@sisd.com 98-mar-16
+#
+# $Log: cust_pay.cgi,v $
+# Revision 1.6 1999-02-28 00:03:35 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/25 12:09:56 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.4 1999/01/19 05:13:37 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 09:41:27 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.2 1998/12/17 06:17:03 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
use strict;
+use vars qw( $cgi $invnum $p1 $_date $payby $payinfo $paid );
use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI);
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl);
-my($cgi) = new CGI::Base;
-$cgi->get;
+$cgi = new CGI;
cgisuidsetup($cgi);
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
+if ( $cgi->param('error') ) {
+ $invnum = $cgi->param('invnum');
+ $paid = $cgi->param('paid');
+ $payby = $cgi->param('payby');
+ $payinfo = $cgi->param('payinfo');
+} else {
+ my ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $invnum = $1;
+ $paid = '';
+ $payby = "BILL";
+ $payinfo = "";
+}
+$_date = time;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Enter payment", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
-SendHeaders(); # one guess.
print <<END;
-<HTML>
- <HEAD>
- <TITLE>Enter payment</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Enter payment</H1>
- </CENTER>
- <FORM ACTION="process/cust_pay.cgi" METHOD=POST>
+ <FORM ACTION="${p1}process/cust_pay.cgi" METHOD=POST>
<HR><PRE>
END
-#invnum
print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!;
-#date
-my($date)=time;
-print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
+print qq!<BR>Date: <B>!, time2str("%D",$_date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$_date">!;
-#paid
-print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" SIZE=8 MAXLENGTH=8>!;
+print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="$paid" SIZE=8 MAXLENGTH=8>!;
-#payby
-my($payby)="BILL";
print qq!<BR>Payby: <B>$payby</B><INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!;
#payinfo (check # now as payby="BILL" hardcoded.. what to do later?)
-my($payinfo)="";
print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!;
#paybatch
print <<END;
</PRE>
<BR>
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
+<INPUT TYPE="submit" VALUE="Post payment">
END
print <<END;
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_pkg.cgi,v 1.8 1999-07-21 07:34:13 ivan Exp $
+#
+# this is for changing packages around, not editing things within the package
+#
+# Usage: cust_pkg.cgi custnum
+# http://server.name/path/cust_pkg.cgi?custnum
+#
+# started with /sales/add/cust_pkg.cgi, which added packages
+# ivan@voicenet.com 97-jan-5, 97-mar-21
+#
+# Rewrote for new API
+# ivan@voicenet.com 97-jul-7
+#
+# FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
+#
+# Changes to allow page to work at a relative position in server
+# Changed to display packages 2-wide in a table
+# bmccane@maxbaud.net 98-apr-3
+#
+# fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
+# 98-jun-1
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.8 1999-07-21 07:34:13 ivan
+# links to package browse and agent type edit if there aren't any packages to
+# order. thanks to "Tech Account" <techy@orac.hq.org>
+#
+# Revision 1.7 1999/04/14 01:03:01 ivan
+# oops, in 1.2 tree, can't do searches until [cgi|admin]suidsetup,
+# bug is hidden by mod_perl persistance
+#
+# Revision 1.6 1999/02/28 00:03:36 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:18 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:13:38 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 09:41:28 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.2 1998/12/17 06:17:04 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+
+use strict;
+use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg
+ $cust_main $agent $type_pkgs $count %remove_pkg $pkgparts );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header popurl);
+use FS::part_pkg;
+use FS::type_pkgs;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+%pkg = ();
+%comment = ();
+foreach (qsearch('part_pkg', {})) {
+ $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
+ $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
+}
+
+if ( $cgi->param('error') ) {
+ $custnum = $cgi->param('custnum');
+ %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg');
+} else {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $custnum = $1;
+ undef %remove_pkg;
+}
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/cust_pkg.cgi" METHOD=POST>!;
+
+print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
+
+#current packages
+@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } );
+
+if (@cust_pkg) {
+ print <<END;
+Current packages - select to remove (services are moved to a new package below)
+<BR><BR>
+END
+
+ my ($count) = 0 ;
+ print qq!<TABLE>! ;
+ foreach (@cust_pkg) {
+ print '<TR>' if $count == 0;
+ my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
+ print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum"!;
+ print " CHECKED" if $remove_pkg{$pkgnum};
+ print qq!>$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
+ $count ++ ;
+ if ($count == 2)
+ {
+ $count = 0 ;
+ print qq!</TR>\n! ;
+ }
+ }
+ print qq!</TABLE><BR><BR>!;
+}
+
+print <<END;
+Order new packages<BR><BR>
+END
+
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+$agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
+
+$count = 0;
+$pkgparts = 0;
+print qq!<TABLE>!;
+foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ $pkgparts++;
+ my($pkgpart)=$type_pkgs->pkgpart;
+ print qq!<TR>! if ( $count == 0 );
+ my $value = $cgi->param("pkg$pkgpart") || 0;
+ print <<END;
+ <TD>
+ <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="$value" SIZE="2" MAXLENGTH="2">
+ $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
+END
+ $count ++ ;
+ if ( $count == 2 ) {
+ print qq!</TR>\n! ;
+ $count = 0;
+ }
+}
+print qq!</TABLE>!;
+
+unless ( $pkgparts ) {
+ my $p2 = popurl(2);
+ my $typenum = $agent->typenum;
+ my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } );
+ my $atype = $agent_type->atype;
+ print <<END;
+(No <a href="${p2}browse/part_pkg.cgi">package definitions</a>, or agent type
+<a href="${p2}edit/agent_type.cgi?$typenum">$atype</a> not allowed to purchase
+any packages.)
+END
+}
+
+#submit
+print <<END;
+<P><INPUT TYPE="submit" VALUE="Order">
+ </FORM>
+ </BODY>
+</HTML>
+END
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $
+#
+# part_pkg.cgi: Add/Edit package (output form)
+#
+# ivan@sisd.com 97-dec-10
+#
+# Changes to allow page to work at a relative position in server
+# Changed to display services 2-wide in table
+# bmccane@maxbaud.net 98-apr-3
+#
+# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: part_pkg.cgi,v $
+# Revision 1.9 1999-02-07 09:59:19 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.8 1999/01/19 05:13:39 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.7 1999/01/18 09:41:29 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.6 1998/12/17 06:17:05 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.5 1998/11/21 07:12:26 ivan
+# *** empty log message ***
+#
+# Revision 1.4 1998/11/21 07:11:08 ivan
+# *** empty log message ***
+#
+# Revision 1.3 1998/11/21 07:07:40 ivan
+# popurl, bugfix
+#
+# Revision 1.2 1998/11/15 13:14:55 ivan
+# first pass as per-user custom pricing
+#
+
+use strict;
+use vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::part_pkg;
+use FS::part_svc;
+use FS::pkg_svc;
+use FS::CGI qw(header menubar popurl);
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {
+ $cgi->param('clone', $1);
+} else {
+ $cgi->param('clone', '');
+}
+if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
+ $cgi->param('pkgnum', $1);
+} else {
+ $cgi->param('pkgnum', '');
+}
+
+($query) = $cgi->keywords;
+$action = '';
+$part_pkg = '';
+if ( $cgi->param('error') ) {
+ $part_pkg = new FS::part_pkg ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_pkg')
+ } );
+}
+if ( $cgi->param('clone') ) {
+ $action='Custom Pricing';
+ my $old_part_pkg =
+ qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } );
+ $part_pkg ||= $old_part_pkg->clone;
+} elsif ( $query && $query =~ /^(\d+)$/ ) {
+ $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1});
+} else {
+ $part_pkg ||= new FS::part_pkg {};
+}
+$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add';
+$hashref = $part_pkg->hashref;
+
+print $cgi->header( '-expires' => 'now' ), header("$action Package Definition", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all packages' => popurl(2). 'browse/part_pkg.cgi',
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>';
+
+if ( $cgi->param('clone') ) {
+ print qq!<INPUT TYPE="hidden" NAME="clone" VALUE="!, $cgi->param('clone'), qq!">!;
+}
+if ( $cgi->param('pkgnum') ) {
+ print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="!, $cgi->param('pkgnum'), qq!">!;
+}
+
+print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!,
+ "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
+
+print <<END;
+<PRE>
+Package (customer-visable) <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}">
+Comment (customer-hidden) <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}">
+Setup fee for this package <INPUT TYPE="text" NAME="setup" VALUE="$hashref->{setup}">
+Recurring fee for this package <INPUT TYPE="text" NAME="recur" VALUE="$hashref->{recur}">
+Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
+
+</PRE>
+
+END
+
+unless ( $cgi->param('clone') ) {
+ print <<END;
+Enter the quantity of each service this package includes.<BR><BR>
+<TABLE BORDER><TR><TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH>
+ <TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH></TR>
+END
+}
+
+$count = 0;
+foreach $part_svc ( ( qsearch( 'part_svc', {} ) ) ) {
+ my $svcpart = $part_svc->svcpart;
+ my $pkg_svc = qsearchs( 'pkg_svc', {
+ 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
+ 'svcpart' => $svcpart,
+ } ) || new FS::pkg_svc ( {
+ 'pkgpart' => $cgi->param('clone') || $part_pkg->pkgpart,
+ 'svcpart' => $svcpart,
+ 'quantity' => 0,
+ });
+ #? #next unless $pkg_svc;
+
+ unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) {
+ print '<TR>' if $count == 0 ;
+ print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!,
+ $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0,
+ qq!"></TD><TD><A HREF="part_svc.cgi?!,$part_svc->svcpart,
+ qq!">!, $part_svc->getfield('svc'), "</A></TD>";
+ $count++;
+ if ($count == 2)
+ {
+ print '</TR>';
+ $count = 0;
+ }
+ } else {
+ print qq!<INPUT TYPE="hidden" NAME="pkg_svc$svcpart" VALUE="!,
+ $cgi->param("pkg_svc$svcpart") || $pkg_svc->quantity || 0, qq!">\n!;
+ }
+}
+
+unless ( $cgi->param('clone') ) {
+ print qq!</TR>! if ($count != 0) ;
+ print "</TABLE>";
+}
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{pkgpart} ? "Apply changes" : "Add package",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_referral.cgi,v 1.6 1999-04-07 11:43:23 ivan Exp $
+#
+# ivan@sisd.com 98-feb-23
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# confisuing typo on submit button ivan@sisd.com 98-jun-14
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_referral.cgi,v $
+# Revision 1.6 1999-04-07 11:43:23 ivan
+# pick up errors right away, leave input
+#
+# Revision 1.5 1999/02/07 09:59:20 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:13:41 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 09:41:30 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.2 1998/12/17 06:17:06 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+
+use strict;
+use vars qw( $cgi $part_referral $action $hashref $p1 $query );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::part_referral;
+use FS::CGI qw(header menubar popurl);
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $part_referral = new FS::part_referral ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_referral')
+ } );
+} elsif ( $cgi->keywords ) {
+ my($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $part_referral = qsearchs( 'part_referral', { 'refnum' => $1 } );
+} else { #adding
+ $part_referral = new FS::part_referral {};
+}
+$action = $part_referral->refnum ? 'Edit' : 'Add';
+$hashref = $part_referral->hashref;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action Referral", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all referrals' => popurl(2). "browse/part_referral.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/part_referral.cgi" METHOD=POST>!;
+
+print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!,
+ "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
+
+print <<END;
+<PRE>
+Referral <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}">
+</PRE>
+END
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{refnum} ? "Apply changes" : "Add referral",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_svc.cgi,v 1.14 2001-05-30 14:42:11 ivan Exp $
+#
+# ivan@sisd.com 97-nov-14
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
+#
+# $Log: part_svc.cgi,v $
+# Revision 1.14 2001-05-30 14:42:11 ivan
+# Adam Rose <adamr@eaze.net>: "In the /edit/part_svc.cgi is there a need to add
+# another section for svc_www?". Yes. Thanks Adam.
+#
+# Revision 1.13 2000/06/15 11:10:31 ivan
+# update to the inline documentation, hopefully will make things more clear
+#
+# Revision 1.12 1999/04/09 04:22:34 ivan
+# also table()
+#
+# Revision 1.11 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.10 1999/04/08 13:01:50 ivan
+# [ AND DOCUMENT! ] all svc_acct services should have a default
+# or fixed shell
+#
+# Revision 1.9 1999/02/23 08:09:21 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.8 1999/02/07 09:59:21 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:42 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:31 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/30 23:03:21 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/17 06:17:07 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.3 1998/11/21 06:43:26 ivan
+# visual
+#
+
+use strict;
+use vars qw( $cgi $part_svc $action $query $hashref $p %defs $svcdb );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs fields);
+use FS::part_svc;
+use FS::CGI qw(header menubar popurl table);
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $part_svc = new FS::part_svc ( {
+ map { $_, scalar($cgi->param($_)) } fields('part_svc')
+ } );
+} elsif ( $cgi->keywords ) {
+ my ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$1});
+} else { #adding
+ $part_svc = new FS::part_svc {};
+}
+$action = $part_svc->svcpart ? 'Edit' : 'Add';
+$hashref = $part_svc->hashref;
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar(
+ 'Main Menu' => $p,
+ 'View all services' => "${p}browse/part_svc.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print '<FORM ACTION="', popurl(1), 'process/part_svc.cgi" METHOD=POST>';
+
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!,
+ "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)";
+
+print <<END;
+<PRE>
+Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}">
+</PRE>
+Services are items you offer to your customers.
+<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts
+ <LI>svc_domain - Virtual domains
+ <LI>svc_acct_sm - Virtual domain mail aliasing
+ <LI>svc_www - Virtual domain website
+END
+# <LI>svc_charge - One-time charges (Partially unimplemented)
+# <LI>svc_wo - Work orders (Partially unimplemented)
+print <<END;
+</UL>
+For the selected table, you can give fields default or fixed (unchangable)
+values. For example, a SLIP/PPP account may have a default (or perhaps fixed)
+<B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed
+blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or
+<B>/usr/bin/passwd</B>.
+<BR><BR>
+END
+print &table(), '<TR><TH>Table<SELECT NAME="svcdb" SIZE=1>',
+ map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw(
+ svc_acct svc_domain svc_acct_sm svc_www
+ );
+ print "</SELECT>";
+# svc_acct svc_domain svc_acct_sm svc_charge svc_wo
+
+print <<END;
+</TH><TH>Field</TH>
+<TH COLSPAN=2>Modifier</TH></TR>
+END
+
+#these might belong somewhere else for other user interfaces
+#pry need to eventually create stuff that's shared amount UIs
+%defs = (
+ 'svc_acct' => {
+ 'dir' => 'Home directory',
+ 'uid' => 'UID (set to fixed and blank for dial-only)',
+ 'slipip' => 'IP address (set to fixed and blank to disable dialin)',
+ 'popnum' => qq!<A HREF="$p/browse/svc_acct_pop.cgi/">POP number</A>!,
+ 'username' => 'Username',
+ 'quota' => '(unimplemented)',
+ '_password' => 'Password',
+ 'gid' => 'GID (when blank, defaults to UID)',
+ 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the <b>shells</b> configuration file)',
+ 'finger' => 'GECOS',
+ },
+ 'svc_domain' => {
+ 'domain' => 'Domain',
+ },
+ 'svc_acct_sm' => {
+ 'domuser' => 'domuser@virtualdomain.com',
+ 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
+ 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
+ },
+ 'svc_charge' => {
+ 'amount' => 'amount',
+ },
+ 'svc_wo' => {
+ 'worker' => 'Worker',
+ '_date' => 'Date',
+ },
+ 'svc_www' => {
+ #'recnum' => '',
+ #'usersvc' => '',
+ },
+);
+
+# svc_acct svc_domain svc_acct_sm svc_charge svc_wo
+foreach $svcdb ( qw(
+ svc_acct svc_domain svc_acct_sm svc_www
+) ) {
+
+ my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
+ grep ! /_flag$/,
+ grep /^${svcdb}__/,
+ fields('part_svc');
+ my($rowspan)=scalar(@rows);
+
+ my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>";
+ my($row);
+ foreach $row (@rows) {
+ my $value = $part_svc->getfield($svcdb. '__'. $row);
+ my $flag = $part_svc->getfield($svcdb. '__'. $row. '_flag');
+ print "<TR>$ptmp<TD>$row";
+ print "- <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT>"
+ if defined $defs{$svcdb}{$row};
+ print "</TD>";
+ print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!.
+ ' CHECKED'x($flag eq ''). ">Off</TD>";
+ print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="D"!.
+ ' CHECKED'x($flag eq 'D'). ">Default ";
+ print qq!<INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="F"!.
+ ' CHECKED'x($flag eq 'F'). ">Fixed ";
+ print qq!<INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
+ "</TD></TR>\n";
+ $ptmp='';
+ }
+}
+print "</TABLE>";
+
+print qq!\n<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{svcpart} ? "Apply changes" : "Add service",
+ qq!">!;
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: agent.cgi,v 1.7 1999-01-25 12:09:57 ivan Exp $
+#
+# ivan@sisd.com 97-dec-12
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: agent.cgi,v $
+# Revision 1.7 1999-01-25 12:09:57 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:13:47 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 22:47:49 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.4 1998/12/30 23:03:26 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 08:40:16 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/23 07:52:29 ivan
+# *** empty log message ***
+#
+
+use strict;
+use vars qw ( $cgi $agentnum $old $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::agent;
+use FS::CGI qw(popurl);
+
+$cgi = new CGI;
+
+&cgisuidsetup($cgi);
+
+$agentnum = $cgi->param('agentnum');
+
+$old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
+
+$new = new FS::agent ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('agent')
+} );
+
+if ( $agentnum ) {
+ $error=$new->replace($old);
+} else {
+ $error=$new->insert;
+ $agentnum=$new->getfield('agentnum');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/agent.cgi");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $
+#
+# ivan@sisd.com 97-dec-11
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: agent_type.cgi,v $
+# Revision 1.7 1999-01-25 12:09:58 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:13:48 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 22:47:50 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.4 1998/12/30 23:03:27 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 08:40:17 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/21 07:49:20 ivan
+# s/CGI::Request/CGI.pm/
+#
+
+use strict;
+use vars qw ( $cgi $typenum $old $new $error $part_pkg );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::CGI qw( popurl);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::agent_type;
+use FS::type_pkgs;
+use FS::part_pkg;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$typenum = $cgi->param('typenum');
+$old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
+
+$new = new FS::agent_type ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('agent_type')
+} );
+
+if ( $typenum ) {
+ $error=$new->replace($old);
+} else {
+ $error=$new->insert;
+ $typenum=$new->getfield('typenum');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string );
+ exit;
+}
+
+foreach $part_pkg (qsearch('part_pkg',{})) {
+ my($pkgpart)=$part_pkg->getfield('pkgpart');
+
+ my($type_pkgs)=qsearchs('type_pkgs',{
+ 'typenum' => $typenum,
+ 'pkgpart' => $pkgpart,
+ });
+ if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) {
+ my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below.
+ $error=$d_type_pkgs->delete;
+ die $error if $error;
+
+ } elsif ( $cgi->param("pkgpart$pkgpart")
+ && ! $type_pkgs
+ ) {
+ #ok to clobber it now (but bad form nonetheless?)
+ $type_pkgs=new FS::type_pkgs ({
+ 'typenum' => $typenum,
+ 'pkgpart' => $pkgpart,
+ });
+ $error= $type_pkgs->insert;
+ die $error if $error;
+ }
+
+}
+
+print $cgi->redirect(popurl(3). "browse/agent_type.cgi");
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_credit.cgi,v 1.7 1999-04-07 15:23:05 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/cust_credit.cgi
+#
+# ivan@voicenet.com 96-dec-05 -> 96-dec-08
+#
+# post a refund if $new_paybatch
+# ivan@voicenet.com 96-dec-08
+#
+# refunds are no longer applied against a specific payment (paybatch)
+# paybatch field removed
+# ivan@voicenet.com 97-apr-22
+#
+# rewrite ivan@sisd.com 98-mar-16
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_credit.cgi,v $
+# Revision 1.7 1999-04-07 15:23:05 ivan
+# don't use anchor in redirect
+#
+# Revision 1.6 1999/02/28 00:03:41 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/25 12:09:59 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.4 1999/01/19 05:13:49 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:47:51 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:18 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $custnum $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw(popurl);
+use FS::Record qw(fields);
+use FS::cust_credit;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
+$custnum = $1;
+
+$cgi->param('otaker',getotaker);
+
+$new = new FS::cust_credit ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(custnum _date amount otaker reason)
+ } fields('cust_credit')
+} );
+
+$error=$new->insert;
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main.cgi,v 1.11 1999-08-10 12:54:06 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/cust_main.cgi
+#
+# ivan@voicenet.com 96-dec-04
+#
+# added referral check
+# ivan@voicenet.com 97-jun-4
+#
+# rewrote for new API
+# ivan@voicenet.com 97-jul-28
+#
+# same as above (again) and clean up some stuff ivan@sisd.com 98-feb-23
+#
+# Changes to allow page to work at a relative position in server
+# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.11 1999-08-10 12:54:06 ivan
+# use FS::cust_pkg::pkgpart_href
+#
+# Revision 1.10 1999/04/14 07:47:53 ivan
+# i18n fixes
+#
+# Revision 1.9 1999/04/07 15:22:19 ivan
+# don't use anchor in redirect
+#
+# Revision 1.8 1999/03/25 13:55:10 ivan
+# one-screen new customer entry (including package and service) for simple
+# packages with one svc_acct service
+#
+# Revision 1.7 1999/02/28 00:03:42 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/01/25 12:10:00 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:50 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:22:32 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.3 1998/12/17 08:40:19 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/18 08:57:36 ivan
+# i18n, s/CGI-modules/CGI.pm/, FS::CGI::idiot instead of inline, FS::CGI::popurl
+#
+
+use strict;
+use vars qw( $cgi $payby @invoicing_list $new $custnum $error );
+use vars qw( $cust_pkg $cust_svc $svc_acct );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw( popurl );
+use FS::Record qw( qsearch qsearchs fields );
+use FS::cust_main;
+use FS::type_pkgs;
+use FS::agent;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#unmunge stuff
+
+$cgi->param('tax','') unless defined($cgi->param('tax'));
+
+$cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] );
+
+$cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/
+ or die "Oops, illegal \"state\" param: ". $cgi->param('state');
+$cgi->param('state', $1);
+$cgi->param('county', $3 || '');
+$cgi->param('country', $4);
+
+if ( $payby = $cgi->param('payby') ) {
+ $cgi->param('payinfo', $cgi->param( $payby. '_payinfo' ) );
+ $cgi->param('paydate',
+ $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' ) );
+ $cgi->param('payname', $cgi->param( $payby. '_payname' ) );
+}
+
+$cgi->param('otaker', &getotaker );
+
+@invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') );
+push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST');
+
+#create new record object
+
+$new = new FS::cust_main ( {
+ map {
+ $_, scalar($cgi->param($_))
+# } qw(custnum agentnum last first ss company address1 address2 city county
+# state zip daytime night fax payby payinfo paydate payname tax
+# otaker refnum)
+ } fields('cust_main')
+} );
+
+#perhaps the invocing_list magic should move to cust_main.pm?
+$error = $new->check_invoicing_list( \@invoicing_list );
+
+#perhaps this stuff should go to cust_main.pm as well
+$cust_pkg = '';
+$svc_acct = '';
+if ( $new->custnum eq '' ) {
+
+ if ( $cgi->param('pkgpart_svcpart') ) {
+ my $x = $cgi->param('pkgpart_svcpart');
+ $x =~ /^(\d+)_(\d+)$/;
+ my($pkgpart, $svcpart) = ($1, $2);
+ #false laziness: copied from FS::cust_pkg::order (which should become a
+ #FS::cust_main method)
+ my(%part_pkg);
+ # generate %part_pkg
+ # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
+ my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum });
+ #my($type_pkgs);
+ #foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
+ # my($pkgpart)=$type_pkgs->pkgpart;
+ # $part_pkg{$pkgpart}++;
+ #}
+ # $pkgpart_href->{PKGPART} is true iff $custnum may purchase $pkgpart
+ my $pkgpart_href = $agent->pkgpart_hashref;
+ #eslaf
+
+ # this should wind up in FS::cust_pkg!
+ $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't".
+ "purchase pkgpart ". $pkgpart
+ #unless $part_pkg{ $pkgpart };
+ unless $pkgpart_href->{ $pkgpart };
+
+ $cust_pkg = new FS::cust_pkg ( {
+ #later 'custnum' => $custnum,
+ 'pkgpart' => $pkgpart,
+ } );
+ $error ||= $cust_pkg->check;
+
+ #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } );
+
+ #$error ||= $cust_svc->check;
+
+ $svc_acct = new FS::svc_acct ( {
+ 'svcpart' => $svcpart,
+ 'username' => $cgi->param('username'),
+ '_password' => $cgi->param('_password'),
+ 'popnum' => $cgi->param('popnum'),
+ } );
+
+ my $y = $svc_acct->setdefault; # arguably should be in new method
+ $error ||= $y unless ref($y);
+ #and just in case you were silly
+ $svc_acct->svcpart($svcpart);
+ $svc_acct->username($cgi->param('username'));
+ $svc_acct->_password($cgi->param('_password'));
+ $svc_acct->popnum($cgi->param('popnum'));
+
+ $error ||= $svc_acct->check;
+
+ } elsif ( $cgi->param('username') ) { #good thing to catch
+ $error = "Can't assign username without a package!";
+ }
+
+ $error ||= $new->insert;
+ if ( $cust_pkg && ! $error ) {
+ $cust_pkg->custnum( $new->custnum );
+ $error ||= $cust_pkg->insert;
+ warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
+ $svc_acct->pkgnum( $cust_pkg->pkgnum );
+ $error ||= $svc_acct->insert;
+ warn "WARNING: $error on pre-checked svc_acct record!" if $error;
+ }
+} else { #create old record object
+ my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } );
+ $error ||= "Old record not found!" unless $old;
+ $error ||= $new->replace($old);
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string );
+} else {
+ $new->invoicing_list( \@invoicing_list );
+ $custnum = $new->custnum;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main_county-expand.cgi,v 1.7 2000-12-21 05:22:30 ivan Exp $
+#
+# ivan@sisd.com 97-dec-16
+#
+# Changes to allow page to work at a relative position in server
+# Added import of datasrc from UID.pm for Pg6.3
+# Default tax to 0.0 if using Pg6.3
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI
+# undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record
+# for that state
+# ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county-expand.cgi,v $
+# Revision 1.7 2000-12-21 05:22:30 ivan
+# perldoc -f split
+#
+# Revision 1.6 1999/01/25 12:19:07 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:51 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:52 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/17 08:40:20 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/18 09:01:40 ivan
+# i18n! i18n!
+#
+
+use strict;
+use vars qw ( $cgi $taxnum $cust_main_county @expansion $expansion );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(popurl);
+use FS::cust_main_county;
+use FS::cust_main;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
+$taxnum = $1;
+$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum})
+ or die ("Unknown taxnum!");
+
+if ( $cgi->param('delim') eq 'n' ) {
+ @expansion=split(/\n/,$cgi->param('expansion'));
+} elsif ( $cgi->param('delim') eq 's' ) {
+ @expansion=split(' ',$cgi->param('expansion'));
+} else {
+ die "Illegal delim!";
+}
+
+@expansion=map {
+ unless ( /^\s*([\w\- ]+)\s*$/ ) {
+ $cgi->param('error', "Illegal item in expansion");
+ print $cgi->redirect(popurl(2). "cust_main_county-expand.cgi?". $cgi->query_string );
+ exit;
+ }
+ $1;
+} @expansion;
+
+foreach ( @expansion) {
+ my(%hash)=$cust_main_county->hash;
+ my($new)=new FS::cust_main_county \%hash;
+ $new->setfield('taxnum','');
+ if ( ! $cust_main_county->state ) {
+ $new->setfield('state',$_);
+ } else {
+ $new->setfield('county',$_);
+ }
+ #if (datasrc =~ m/Pg/)
+ #{
+ # $new->setfield('tax',0.0);
+ #}
+ my($error)=$new->insert;
+ die $error if $error;
+}
+
+unless ( qsearch('cust_main',{
+ 'state' => $cust_main_county->getfield('state'),
+ 'county' => $cust_main_county->getfield('county'),
+ 'country' => $cust_main_county->getfield('country'),
+} ) ) {
+ my($error)=($cust_main_county->delete);
+ die $error if $error;
+}
+
+print $cgi->redirect(popurl(3). "edit/cust_main_county.cgi");
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $
+#
+# ivan@sisd.com 97-dec-16
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: cust_main_county.cgi,v $
+# Revision 1.6 1999-01-25 12:19:08 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:52 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:53 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/17 08:40:21 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/18 09:01:41 ivan
+# i18n! i18n!
+#
+
+use strict;
+use vars qw( $cgi );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main_county;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+foreach ( $cgi->param ) {
+ /^tax(\d+)$/ or die "Illegal form $_!";
+ my($taxnum)=$1;
+ my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
+ or die "Couldn't find taxnum $taxnum!";
+ next unless $old->getfield('tax') ne $cgi->param("tax$taxnum");
+ my(%hash)=$old->hash;
+ $hash{tax}=$cgi->param("tax$taxnum");
+ my($new)=new FS::cust_main_county \%hash;
+ my($error)=$new->replace($old);
+ if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string );
+ exit;
+ }
+}
+
+print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi");
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_pay.cgi,v 1.7 1999-02-28 00:03:43 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/cust_pay.cgi
+#
+# ivan@voicenet.com 96-dec-11
+#
+# rewrite ivan@sisd.com 98-mar-16
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_pay.cgi,v $
+# Revision 1.7 1999-02-28 00:03:43 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/01/25 12:19:09 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.5 1999/01/19 05:13:53 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:54 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/30 23:03:28 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.2 1998/12/17 08:40:22 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $invnum $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
+use FS::Record qw(fields);
+use FS::cust_pay;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$invnum = $1;
+
+$new = new FS::cust_pay ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(invnum paid _date payby payinfo paybatch)
+ } fields('cust_pay')
+} );
+
+$error=$new->insert;
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). 'cust_pay.cgi?'. $cgi->query_string );
+ exit;
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_bill.cgi?$invnum");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_pkg.cgi,v 1.7 1999-04-07 15:24:06 ivan Exp $
+#
+# this is for changing packages around, not for editing things within the
+# package
+#
+# Usage: post form to:
+# http://server.name/path/cust_pkg.cgi
+#
+# ivan@voicenet.com 97-mar-21 - 97-mar-24
+#
+# rewrote for new API
+# ivan@voicenet.com 97-jul-7 - 15
+#
+# &cgisuidsetup($cgi) ivan@sisd.com 98-mar-7
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.7 1999-04-07 15:24:06 ivan
+# don't use anchor in redirect
+#
+# Revision 1.6 1999/02/28 00:03:44 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:26 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.3 1999/01/19 05:13:54 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 08:40:23 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
+use FS::cust_pkg;
+
+$cgi = new CGI; # create form object
+&cgisuidsetup($cgi);
+$error = '';
+
+#untaint custnum
+$cgi->param('custnum') =~ /^(\d+)$/;
+$custnum = $1;
+
+@remove_pkgnums = map {
+ /^(\d+)$/ or die "Illegal remove_pkg value!";
+ $1;
+} $cgi->param('remove_pkg');
+
+foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) {
+ if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) {
+ my $num_pkgs = $1;
+ while ( $num_pkgs-- ) {
+ push @pkgparts,$pkgpart;
+ }
+ } else {
+ $error = "Illegal quantity";
+ last;
+ }
+}
+
+$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_pkg.cgi,v 1.9 2001-04-09 23:05:16 ivan Exp $
+#
+# process/part_pkg.cgi: Edit package definitions (process form)
+#
+# ivan@sisd.com 97-dec-10
+#
+# don't update non-changing records in part_svc (causing harmless but annoying
+# "Records identical" errors). ivan@sisd.com 98-feb-19
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_pkg.cgi,v $
+# Revision 1.9 2001-04-09 23:05:16 ivan
+# Transactions Part I!!!
+#
+# Revision 1.8 1999/02/07 09:59:27 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:55 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 22:47:56 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.5 1998/12/30 23:03:29 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/17 08:40:24 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.3 1998/11/21 07:17:58 ivan
+# bugfix to work for regular aswell as custom pricing
+#
+# Revision 1.2 1998/11/15 13:16:15 ivan
+# first pass as per-user custom pricing
+#
+
+use strict;
+use vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::part_pkg;
+use FS::pkg_svc;
+use FS::cust_pkg;
+
+$cgi = new CGI;
+$dbh = &cgisuidsetup($cgi);
+
+$pkgpart = $cgi->param('pkgpart');
+
+$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
+
+$new = new FS::part_pkg ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('part_pkg')
+} );
+
+#most of the stuff below should move to part_pkg.pm
+
+foreach $part_svc ( qsearch('part_svc', {} ) ) {
+ my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
+ unless ( $quantity =~ /^(\d+)$/ ) {
+ $cgi->param('error', "Illegal quantity" );
+ print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
+ exit;
+ }
+}
+
+local $SIG{HUP} = 'IGNORE';
+local $SIG{INT} = 'IGNORE';
+local $SIG{QUIT} = 'IGNORE';
+local $SIG{TERM} = 'IGNORE';
+local $SIG{TSTP} = 'IGNORE';
+local $SIG{PIPE} = 'IGNORE';
+
+local $FS::UID::AutoCommit = 0;
+
+if ( $pkgpart ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $pkgpart=$new->pkgpart;
+}
+if ( $error ) {
+ $dbh->rollback;
+ $cgi->param('error', $error );
+ print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string );
+ exit;
+}
+
+foreach $part_svc (qsearch('part_svc',{})) {
+ my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0;
+ my $old_pkg_svc = qsearchs('pkg_svc', {
+ 'pkgpart' => $pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ } );
+ my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
+ next unless $old_quantity != $quantity; #!here
+ my $new_pkg_svc = new FS::pkg_svc( {
+ 'pkgpart' => $pkgpart,
+ 'svcpart' => $part_svc->svcpart,
+ 'quantity' => $quantity,
+ } );
+ if ( $old_pkg_svc ) {
+ my $myerror = $new_pkg_svc->replace($old_pkg_svc);
+ if ( $myerror ) {
+ $dbh->rollback;
+ die $myerror;
+ }
+ } else {
+ my $myerror = $new_pkg_svc->insert;
+ if ( $myerror ) {
+ $dbh->rollback;
+ die $myerror;
+ }
+ }
+}
+
+unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) {
+ $dbh->commit or die $dbh->errstr;
+ print $cgi->redirect(popurl(3). "browse/part_pkg.cgi");
+} else {
+ my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } );
+ my %hash = $old_cust_pkg->hash;
+ $hash{'pkgpart'} = $pkgpart;
+ my($new_cust_pkg) = new FS::cust_pkg \%hash;
+ my $myerror = $new_cust_pkg->replace($old_cust_pkg);
+ if ( $myerror ) {
+ $dbh->rollback;
+ die "Error modifying cust_pkg record: $myerror\n";
+ }
+
+ $dbh->commit or die $dbh->errstr;
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum);
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $
+#
+# ivan@sisd.com 98-feb-23
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_referral.cgi,v $
+# Revision 1.6 1999-02-07 09:59:28 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.5 1999/01/19 05:13:56 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:47:57 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/30 23:03:30 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.2 1998/12/17 08:40:25 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $refnum $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs fields);
+use FS::part_referral;
+use FS::CGI qw(popurl);
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$refnum = $cgi->param('refnum');
+
+$new = new FS::part_referral ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('part_referral')
+} );
+
+if ( $refnum ) {
+ my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } );
+ die "(Old) Record not found!" unless $old;
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+}
+$refnum=$new->refnum;
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/part_referral.cgi");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $
+#
+# ivan@sisd.com 97-nov-14
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: part_svc.cgi,v $
+# Revision 1.7 1999-02-07 09:59:29 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:13:57 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 22:47:58 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.4 1998/12/30 23:03:31 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 08:40:26 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+# Revision 1.2 1998/11/21 06:43:08 ivan
+# s/CGI::Request/CGI.pm/
+#
+
+use strict;
+use vars qw ( $cgi $svcpart $old $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs fields);
+use FS::part_svc;
+use FS::CGI qw(popurl);
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$svcpart = $cgi->param('svcpart');
+
+$old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
+
+$new = new FS::part_svc ( {
+ map {
+ $_, scalar($cgi->param($_));
+# } qw(svcpart svc svcdb)
+ } fields('part_svc')
+} );
+
+if ( $svcpart ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcpart=$new->getfield('svcpart');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3)."browse/part_svc.cgi");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct.cgi,v 1.7 1999-08-27 00:26:33 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/svc_acct.cgi
+#
+# ivan@voicenet.com 96-dec-18
+#
+# Changed /u to /u2
+# ivan@voicenet.com 97-may-6
+#
+# rewrote for new API
+# ivan@voicenet.com 97-jul-17 - 21
+#
+# no FS::Search, FS::svc_acct creates FS::cust_svc record, used for adding
+# and editing ivan@sisd.com 98-mar-8
+#
+# Changes to allow page to work at a relative position in server
+# Changed 'password' to '_password' because Pg6.3 reserves the password word
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.7 1999-08-27 00:26:33 ivan
+# better error messages
+#
+# Revision 1.6 1999/02/28 00:03:45 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:30 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:13:58 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:47:59 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:27 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $svcnum $old $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
+use FS::Record qw(qsearchs fields);
+use FS::svc_acct;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$svcnum = $1;
+
+if ( $svcnum ) {
+ $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } )
+ or die "fatal: can't find account (svcnum $svcnum)!";
+} else {
+ $old = '';
+}
+
+#unmunge popnum
+$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] );
+
+#unmunge passwd
+if ( $cgi->param('_password') eq '*HIDDEN*' ) {
+ die "fatal: no previous account to recall hidden password from!" unless $old;
+ $cgi->param('_password',$old->getfield('_password'));
+}
+
+$new = new FS::svc_acct ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
+ # shell quota slipip)
+ } ( fields('svc_acct'), qw( pkgnum svcpart ) )
+} );
+
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->svcnum;
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum );
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $
+#
+# ivan@sisd.com 98-mar-8
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: svc_acct_pop.cgi,v $
+# Revision 1.6 1999-02-07 09:59:31 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.5 1999/01/19 05:13:59 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 22:48:00 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.3 1998/12/30 23:03:32 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.2 1998/12/17 08:40:28 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $popnum $old $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct_pop;
+use FS::CGI qw(popurl);
+
+$cgi = new CGI; # create form object
+
+&cgisuidsetup($cgi);
+
+$popnum = $cgi->param('popnum');
+
+$old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
+
+$new = new FS::svc_acct_pop ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('svc_acct_pop')
+} );
+
+if ( $popnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $popnum=$new->getfield('popnum');
+}
+
+if ( $error ) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_sm.cgi,v 1.6 1999-02-28 00:03:46 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/svc_acct_sm.cgi
+#
+# lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled.
+#
+# ivan@voicenet.com 97-jan-6
+#
+# enabled modifications
+#
+# ivan@voicenet.com 97-may-7
+#
+# fixed removal of cust_svc record on modifications!
+# ivan@voicenet.com 97-jun-5
+#
+# rewrite ivan@sisd.com 98-mar-15
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.6 1999-02-28 00:03:46 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:32 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:00 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:48:01 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:29 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $svcnum $old $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs fields);
+use FS::svc_acct_sm;
+use FS::CGI qw(popurl);
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$svcnum =$1;
+
+$old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
+
+#unmunge domsvc and domuid
+#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] );
+#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] );
+
+$new = new FS::svc_acct_sm ( {
+ map {
+ ($_, scalar($cgi->param($_)));
+ #} qw(svcnum pkgnum svcpart domuser domuid domsvc)
+ } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) )
+} );
+
+if ( $svcnum ) {
+ $error = $new->replace($old);
+} else {
+ $error = $new->insert;
+ $svcnum = $new->getfield('svcnum');
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_domain.cgi,v 1.7 2001-04-23 07:12:44 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/svc_domain.cgi
+#
+# lots of yucky stuff in this one... bleachlkjhui!
+#
+# ivan@voicenet.com 97-jan-6
+#
+# kludged for new domain template 3.5
+# ivan@voicenet.com 97-jul-24
+#
+# moved internic bits to svc_domain.pm ivan@sisd.com 98-mar-14
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.7 2001-04-23 07:12:44 ivan
+# better error message (if kludgy) for no referral
+# remove outdated NSI foo from domain ordering. also, fuck NSI.
+#
+# Revision 1.6 1999/02/28 00:03:47 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:33 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:01 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1999/01/18 22:48:02 ivan
+# s/create/new/g; and use fields('table_name')
+#
+# Revision 1.2 1998/12/17 08:40:30 ivan
+# s/CGI::Request/CGI.pm/; etc
+#
+
+use strict;
+use vars qw( $cgi $svcnum $new $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs fields);
+use FS::svc_domain;
+use FS::CGI qw(popurl);
+
+#remove this to actually test the domains!
+$FS::svc_domain::whois_hack = 1;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
+$svcnum = $1;
+
+$new = new FS::svc_domain ( {
+ map {
+ $_, scalar($cgi->param($_));
+ #} qw(svcnum pkgnum svcpart domain action purpose)
+ } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) )
+} );
+
+if ($cgi->param('svcnum')) {
+ $error="Can't modify a domain!";
+} else {
+ $error=$new->insert;
+ $svcnum=$new->svcnum;
+}
+
+if ($error) {
+ $cgi->param('error', $error);
+ print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string );
+} else {
+ print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum");
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct.cgi,v 1.10 1999-04-14 11:27:06 ivan Exp $
+#
+# Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
+# http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
+#
+# ivan@voicenet.com 96-dec-18
+#
+# rewrite ivan@sisd.com 98-mar-8
+#
+# Changes to allow page to work at a relative position in server
+# Changed 'password' to '_password' because Pg6.3 reserves the password word
+# bmccane@maxbaud.net 98-apr-3
+#
+# use conf/shells and dbdef username length ivan@sisd.com 98-jul-13
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.10 1999-04-14 11:27:06 ivan
+# showpasswords config option to show passwords
+#
+# Revision 1.9 1999/02/28 00:03:37 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/23 08:09:22 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.7 1999/02/07 09:59:22 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:13:43 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:32 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/30 23:03:22 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/17 06:17:08 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+
+use strict;
+use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart
+ $part_svc $svc $otaker $username $password $ulen $ulen2 $p1
+ $popnum $uid $gid $finger $dir $shell $quota $slipip );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct;
+use FS::Conf;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+@shells = $conf->config('shells');
+
+if ( $cgi->param('error') ) {
+ $svc_acct = new FS::svc_acct ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct')
+ } );
+ $svcnum = $svc_acct->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+} else {
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_acct) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_acct = new FS::svc_acct({});
+
+ foreach $_ (split(/-/,$query)) {
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set gecos
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ if ($cust_pkg) {
+ my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
+ $svc_acct->setfield('finger',
+ $cust_main->getfield('first') . " " . $cust_main->getfield('last')
+ ) ;
+ }
+
+ #set fixed and default fields from part_svc
+ my($field);
+ foreach $field ( fields('svc_acct') ) {
+ if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) {
+ $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
+ }
+ }
+
+ }
+}
+$action = $svcnum ? 'Edit' : 'Add';
+
+$svc = $part_svc->getfield('svc');
+
+$otaker = getotaker;
+
+$username = $svc_acct->username;
+if ( $svc_acct->_password ) {
+ if ( $conf->exists('showpasswords') ) {
+ $password = $svc_acct->_password;
+ } else {
+ $password = "*HIDDEN*";
+ }
+} else {
+ $password = '';
+}
+
+$ulen = $svc_acct->dbdef_table->column('username')->length;
+$ulen2 = $ulen+2;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action $svc account");
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print <<END;
+ <FORM ACTION="${p1}process/svc_acct.cgi" METHOD=POST>
+ <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
+ <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
+ <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
+Username:
+<INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen>
+<BR>Password:
+<INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
+(blank to generate)
+END
+
+#pop
+$popnum = $svc_acct->popnum || 0;
+if ( $part_svc->svc_acct__popnum_flag eq "F" ) {
+ print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
+} else {
+ print qq!<BR>POP: <SELECT NAME="popnum" SIZE=1><OPTION>\n!;
+ my($svc_acct_pop);
+ foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
+ print "<OPTION", $svc_acct_pop->popnum == $popnum ? ' SELECTED' : '', ">",
+ $svc_acct_pop->popnum, ": ",
+ $svc_acct_pop->city, ", ",
+ $svc_acct_pop->state,
+ " (", $svc_acct_pop->ac, ")/",
+ $svc_acct_pop->exch, "\n"
+ ;
+ }
+ print "</SELECT>";
+}
+
+($uid,$gid,$finger,$dir)=(
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+);
+
+print <<END;
+<INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
+<INPUT TYPE="hidden" NAME="gid" VALUE="$gid">
+<BR>GECOS: <INPUT TYPE="text" NAME="finger" VALUE="$finger">
+<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">
+END
+
+$shell = $svc_acct->shell;
+if ( $part_svc->svc_acct__shell_flag eq "F" ) {
+ print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
+} else {
+ print qq!<BR>Shell: <SELECT NAME="shell" SIZE=1>!;
+ my($etc_shell);
+ foreach $etc_shell (@shells) {
+ print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">",
+ $etc_shell, "\n";
+ }
+ print "</SELECT>";
+}
+
+($quota,$slipip)=(
+ $svc_acct->quota,
+ $svc_acct->slipip,
+);
+
+print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!;
+
+if ( $part_svc->svc_acct__slipip_flag eq "F" ) {
+ print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!;
+} else {
+ print qq!<BR>IP: <INPUT TYPE="text" NAME="slipip" VALUE="$slipip">!;
+}
+
+#submit
+print qq!<P><INPUT TYPE="submit" VALUE="Submit">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_pop.cgi,v 1.9 2000-01-28 23:02:48 ivan Exp $
+#
+# ivan@sisd.com 98-mar-8
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# lose background, FS::CGI ivan@sisd.com 98-sep-2
+#
+# $Log: svc_acct_pop.cgi,v $
+# Revision 1.9 2000-01-28 23:02:48 ivan
+# track full phone number
+#
+# Revision 1.8 1999/02/23 08:09:23 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.7 1999/02/07 09:59:23 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:13:44 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:33 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/23 02:57:45 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 06:17:10 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/13 09:56:47 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
+
+use strict;
+use vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::CGI qw(header menubar popurl);
+use FS::svc_acct_pop;
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $svc_acct_pop = new FS::svc_acct_pop ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop')
+ } );
+} elsif ( $cgi->keywords ) { #editing
+ my($query)=$cgi->keywords;
+ $query =~ /^(\d+)$/;
+ $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
+} else { #adding
+ $svc_acct_pop = new FS::svc_acct_pop {};
+}
+$action = $svc_acct_pop->popnum ? 'Edit' : 'Add';
+$hashref = $svc_acct_pop->hashref;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar(
+ 'Main Menu' => popurl(2),
+ 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi",
+));
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_acct_pop.cgi" METHOD=POST>!;
+
+#display
+
+print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!,
+ "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)";
+
+print <<END;
+<PRE>
+City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
+State <INPUT TYPE="text" NAME="state" SIZE=16 MAXLENGTH=16 VALUE="$hashref->{state}">
+Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}">
+Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}">
+Local <INPUT TYPE="text" NAME="loc" SIZE=5 MAXLENGTH=4 VALUE="$hashref->{loc}">
+</PRE>
+END
+
+print qq!<BR><INPUT TYPE="submit" VALUE="!,
+ $hashref->{popnum} ? "Apply changes" : "Add POP",
+ qq!">!;
+
+print <<END;
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:03:38 ivan Exp $
+#
+# Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
+# http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
+#
+# use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add
+#
+# should error out in a more CGI-friendly way, and should have more error checking (sigh).
+#
+# ivan@voicenet.com 97-jan-5
+#
+# added debugging code; fixed CPU-sucking problem with trying to edit an (unaudited) mail alias (no pkgnum)
+#
+# ivan@voicenet.com 97-may-7
+#
+# fixed uid selection
+# ivan@voicenet.com 97-jun-4
+#
+# uid selection across _CUSTOMER_, not just _PACKAGE_
+#
+# ( i need to be rewritten with fast searches)
+#
+# ivan@voicenet.com 97-oct-3
+#
+# added fast searches in some of the places where it is sorely needed...
+# I see DBI::mysql in your future...
+# ivan@voicenet.com 97-oct-23
+#
+# rewrite ivan@sisd.com 98-mar-15
+#
+# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.9 1999-02-28 00:03:38 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/07 09:59:24 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:45 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:34 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/30 23:03:24 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/23 02:58:45 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 06:17:11 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/12/16 05:19:15 ivan
+# use FS::Conf
+#
+
+use strict;
+use vars qw( $conf $cgi $mydomain $action $svcnum $svc_acct_sm $pkgnum $svcpart
+ $part_svc $query %username %domain $p1 $domuser $domsvc $domuid );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_acct_sm;
+use FS::Conf;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+if ( $cgi->param('error') ) {
+ $svc_acct_sm = new FS::svc_acct_sm ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm')
+ } );
+ $svcnum = $svc_acct_sm->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+} else {
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_acct_sm) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_acct_sm = new FS::svc_acct_sm({});
+
+ foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ my($field);
+ foreach $field ( fields('svc_acct_sm') ) {
+ if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) {
+ $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
+ }
+ }
+
+ }
+}
+$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add';
+
+if ($pkgnum) {
+
+ #find all possible uids (and usernames)
+
+ my($u_part_svc,@u_acct_svcparts);
+ foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
+ push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
+ }
+
+ my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ my($custnum)=$cust_pkg->getfield('custnum');
+ my($i_cust_pkg);
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
+ #record(s) in cust_svc ( for this
+ #pkgnum ! )
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
+ }
+ }
+ }
+
+ #find all possible domains (and domsvc's)
+
+ my($d_part_svc,@d_acct_svcparts);
+ foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
+ push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
+ }
+
+ foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
+ my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
+ my($acct_svcpart);
+ foreach $acct_svcpart (@d_acct_svcparts) {
+ my($i_cust_svc);
+ foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
+ my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
+ $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
+ }
+ }
+ }
+
+} elsif ( $action eq 'Edit' ) {
+
+ my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
+ $username{$svc_acct_sm->uid} = $svc_acct->username;
+
+ my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
+ $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
+
+} else {
+ die "\$action eq Add, but \$pkgnum is null!\n";
+}
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print qq!<FORM ACTION="${p1}process/svc_acct_sm.cgi" METHOD=POST>!;
+
+#display
+
+ #formatting
+ print "<PRE>";
+
+#svcnum
+print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
+print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
+
+#pkgnum
+print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
+
+#svcpart
+print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
+
+($domuser,$domsvc,$domuid)=(
+ $svc_acct_sm->domuser,
+ $svc_acct_sm->domsvc,
+ $svc_acct_sm->domuid,
+);
+
+#domuser
+print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
+
+#domsvc
+print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
+foreach $_ (keys %domain) {
+ print "<OPTION", $_ eq $domsvc ? " SELECTED" : "",
+ qq! VALUE="$_">$domain{$_}!;
+}
+print "</SELECT>";
+
+#uid
+print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
+foreach $_ (keys %username) {
+ print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "",
+ qq! VALUE="$_">$username{$_}!;
+}
+print "</SELECT>\@$mydomain mailbox.";
+
+ #formatting
+ print "</PRE>\n";
+
+print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
+
+print <<END;
+
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_domain.cgi,v 1.10 2001-04-23 07:12:44 ivan Exp $
+#
+# Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart}
+# http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart}
+#
+# ivan@voicenet.com 97-jan-5 -> 97-jan-6
+#
+# changes for domain template 3.5
+# ivan@voicenet.com 97-jul-24
+#
+# rewrite ivan@sisd.com 98-mar-14
+#
+# no GOV in instructions ivan@sisd.com 98-jul-17
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.10 2001-04-23 07:12:44 ivan
+# better error message (if kludgy) for no referral
+# remove outdated NSI foo from domain ordering. also, fuck NSI.
+#
+# Revision 1.9 1999/02/28 00:03:39 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/07 09:59:25 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/19 05:13:46 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:35 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/30 23:03:25 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.4 1998/12/23 03:00:16 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 06:17:12 ivan
+# fix double // in relative URLs, s/CGI::Base/CGI/;
+#
+# Revision 1.2 1998/11/13 09:56:48 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
+
+use strict;
+use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc
+ $svc $otaker $domain $p1 $kludge_action $purpose );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup getotaker);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs fields);
+use FS::svc_domain;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+if ( $cgi->param('error') ) {
+ $svc_domain = new FS::svc_domain ( {
+ map { $_, scalar($cgi->param($_)) } fields('svc_domain')
+ } );
+ $svcnum = $svc_domain->svcnum;
+ $pkgnum = $cgi->param('pkgnum');
+ $svcpart = $cgi->param('svcpart');
+ $kludge_action = $cgi->param('action');
+ $purpose = $cgi->param('purpose');
+ $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
+ die "No part_svc entry!" unless $part_svc;
+} else {
+ $kludge_action = '';
+ $purpose = '';
+ my($query) = $cgi->keywords;
+ if ( $query =~ /^(\d+)$/ ) { #editing
+ $svcnum=$1;
+ $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
+ or die "Unknown (svc_domain) svcnum!";
+
+ my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
+ or die "Unknown (cust_svc) svcnum!";
+
+ $pkgnum=$cust_svc->pkgnum;
+ $svcpart=$cust_svc->svcpart;
+
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ } else { #adding
+
+ $svc_domain = new FS::svc_domain({});
+
+ foreach $_ (split(/-/,$query)) {
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+ }
+ $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
+ die "No part_svc entry!" unless $part_svc;
+
+ $svcnum='';
+
+ #set fixed and default fields from part_svc
+ my($field);
+ foreach $field ( fields('svc_domain') ) {
+ if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) {
+ $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
+ }
+ }
+
+ }
+}
+$action = $svcnum ? 'Edit' : 'Add';
+
+$svc = $part_svc->getfield('svc');
+
+$otaker = getotaker;
+
+$domain = $svc_domain->domain;
+
+$p1 = popurl(1);
+print $cgi->header( '-expires' => 'now' ), header("$action $svc", '');
+
+print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'),
+ "</FONT>"
+ if $cgi->param('error');
+
+print <<END;
+ <FORM ACTION="${p1}process/svc_domain.cgi" METHOD=POST>
+ <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
+ <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
+ <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
+END
+
+print qq!<INPUT TYPE="radio" NAME="action" VALUE="N"!;
+print ' CHECKED' if $kludge_action eq 'N';
+print qq!>New!;
+print qq!<BR><INPUT TYPE="radio" NAME="action" VALUE="M"!;
+print ' CHECKED' if $kludge_action eq 'M';
+print qq!>Transfer!;
+
+print <<END;
+<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26>
+<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="$purpose" SIZE=64>
+<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
+<UL>
+ <LI>COM is for commercial, for-profit organziations
+ <LI>ORG is for miscellaneous, usually, non-profit organizations
+ <LI>NET is for network infrastructure machines and organizations
+ <LI>EDU is for 4-year, degree granting institutions
+<!-- <LI>GOV is for United States federal government agencies
+!-->
+</UL>
+US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain
+and registration procedures.
+<!-- <P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816).
+!-->
+ </FORM>
+ </BODY>
+</HTML>
+END
+
--- /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.png">
+ </td><td>
+ <center><font color="#ff0000" size=7>freeside main menu</font></center>
+ </td></tr>
+ </table>
+ <A HREF="http://www.sisd.com/freeside">
+ Freeside home page
+ </A>
+ <BR><A HREF="docs/">
+ Documentation
+ </A>
+ </P>
+ <HR>
+ <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/cust_bill.html">invoices (by invoice number)</A>
+ </ul>
+ <li><A NAME="browse">Browse</A>
+ <ul>
+ <LI>customers (<A HREF="search/cust_main.cgi?custnum">by customer number</A>) (<A HREF="search/cust_main.cgi?last">by last name</A>) (<A HREF="search/cust_main.cgi?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>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>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 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>
+ </ul>
+ <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 POPs
+ </A>
+ - Points of Presence
+ </ul>
+ </ul>
+ </BODY>
+</HTML>
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: bill.cgi,v 1.5 1999-08-12 04:32:21 ivan Exp $
+#
+# s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: bill.cgi,v $
+# Revision 1.5 1999-08-12 04:32:21 ivan
+# hidecancelledcustomers
+#
+# Revision 1.4 1999/01/19 05:14:02 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:01:13 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:41 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw( $cgi $query $custnum $cust_main $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
+use FS::Record qw(qsearchs);
+use FS::cust_main;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#untaint custnum
+($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+$custnum = $1;
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+die "Can't find customer!\n" unless $cust_main;
+
+$error = $cust_main->bill(
+# 'time'=>$time
+ );
+&eidiot($error) if $error;
+
+$error = $cust_main->collect(
+# 'invoice-time'=>$time,
+# 'batch_card'=> 'yes',
+ 'batch_card'=> 'no',
+ 'report_badcard'=> 'yes',
+ );
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum");
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cancel-unaudited.cgi,v 1.8 2001-04-09 23:05:16 ivan Exp $
+#
+# Usage: cancel-unaudited.cgi svcnum
+# http://server.name/path/cancel-unaudited.cgi pkgnum
+#
+# 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
+#
+# $Log: cancel-unaudited.cgi,v $
+# Revision 1.8 2001-04-09 23:05:16 ivan
+# Transactions Part I!!!
+#
+# Revision 1.7 2000/06/15 12:30:37 ivan
+# bugfix from Jeff Finucane, thanks!
+#
+# Revision 1.6 1999/02/28 00:03:48 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/02/07 09:59:34 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:03 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:02:05 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:42 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error $dbh );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
+use FS::Record qw(qsearchs);
+use FS::cust_svc;
+use FS::svc_acct;
+
+$cgi = new CGI;
+$dbh = &cgisuidsetup($cgi);
+
+#untaint svcnum
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+
+$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+die "Unknown svcnum!" unless $svc_acct;
+
+$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;
+
+$error = $svc_acct->cancel;
+&myeidiot($error) if $error;
+$error = $svc_acct->delete;
+&myeidiot($error) if $error;
+
+$error = $cust_svc->delete;
+&myeidiot($error) if $error;
+
+$dbh->commit or die $dbh->errstr;
+
+print $cgi->redirect(popurl(2));
+
+sub myeidiot {
+ $dbh->rollback;
+ &eidiot(@_);
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cancel_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
+#
+# Usage: cancel_pkg.cgi pkgnum
+# http://server.name/path/cancel_pkg.cgi pkgnum
+#
+# 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
+#
+# $Log: cancel_pkg.cgi,v $
+# Revision 1.6 1999-04-08 10:35:02 ivan
+# import necessary subroutines from FS::CGI
+#
+# Revision 1.5 1999/02/28 00:03:49 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:04 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:02:54 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:43 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(eidiot popurl);
+use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl eidiot);
+use FS::cust_pkg;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#untaint pkgnum
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
+
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+
+$error = $cust_pkg->cancel;
+eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $
+#
+# $Log: delete-customer.cgi,v $
+# Revision 1.1 1999-04-15 16:44:36 ivan
+# delete customers
+#
+
+use strict;
+use vars qw( $cgi $conf $query $custnum $new_custnum $cust_main );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+if ( $cgi->param('error') ) {
+ $custnum = $cgi->param('custnum');
+ $new_custnum = $cgi->param('new_custnum');
+} else {
+ ($query) = $cgi->keywords;
+ $query =~ /^(\d+)$/ or die "Illegal query: $query";
+ $custnum = $1;
+ $new_custnum = '';
+}
+$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+ or die "Customer not found: $custnum";
+
+print $cgi->header ( '-expires' => 'now' ), 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.
+<br>Are you <b>absolutely sure</b> you want to delete this customer?
+<br><input type="submit" value="Yes">
+</form></body></html>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: expire_pkg.cgi,v 1.4 1999-02-28 00:03:50 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/expire_pkg.cgi
+#
+# 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
+#
+# $Log: expire_pkg.cgi,v $
+# Revision 1.4 1999-02-28 00:03:50 ivan
+# removed misleading comments
+#
+# Revision 1.3 1999/01/19 05:14:05 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:12:44 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi $date $pkgnum $cust_pkg %hash $new $error );
+use Date::Parse;
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
+use FS::Record qw(qsearchs);
+use FS::cust_pkg;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#untaint date & pkgnum
+
+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";
+$pkgnum = $1;
+
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+%hash = $cust_pkg->hash;
+$hash{expire}=$date;
+$new = new FS::cust_pkg ( \%hash );
+$error = $new->replace($cust_pkg);
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: link.cgi,v 1.7 1999-04-08 11:31:40 ivan Exp $
+#
+# ivan@voicenet.com 97-feb-5
+#
+# rewrite ivan@sisd.com 98-mar-17
+#
+# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
+#
+# $Log: link.cgi,v $
+# Revision 1.7 1999-04-08 11:31:40 ivan
+# *** empty log message ***
+#
+# Revision 1.6 1999/02/28 00:03:51 ivan
+# removed misleading comments
+#
+# Revision 1.5 1999/01/19 05:14:06 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:36 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/23 03:03:39 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:45 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( %link_field $cgi $pkgnum $svcpart $query $part_svc $svc $svcdb
+ $link_field );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl header);
+use FS::Record qw(qsearchs);
+
+%link_field = (
+ 'svc_acct' => 'username',
+ 'svc_domain' => 'domain',
+ 'svc_acct_sm' => '',
+ 'svc_charge' => '',
+ 'svc_wo' => '',
+);
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+($query) = $cgi->keywords;
+foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart
+ $pkgnum=$1 if /^pkgnum(\d+)$/;
+ $svcpart=$1 if /^svcpart(\d+)$/;
+}
+
+$part_svc = qsearchs('part_svc',{'svcpart'=>$svcpart});
+$svc = $part_svc->getfield('svc');
+$svcdb = $part_svc->getfield('svcdb');
+$link_field = $link_field{$svcdb};
+
+print $cgi->header( '-expires' => 'now' ), header("Link to existing $svc"),
+ qq!<FORM ACTION="!, popurl(1), qq!process/link.cgi" METHOD=POST>!;
+
+if ( $link_field ) {
+ print <<END;
+ <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
+#
+# $Id: print-invoice.cgi,v 1.4 1999-01-19 05:14:07 ivan Exp $
+#
+# just a kludge for now, since this duplicates in a way it shouldn't stuff from
+# Bill.pm (like $lpr) ivan@sisd.com 98-jun-16
+#
+# $Log: print-invoice.cgi,v $
+# Revision 1.4 1999-01-19 05:14:07 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:04:24 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:47 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw($conf $cgi $lpr $query $invnum $cust_bill $custnum );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl);
+use FS::Record qw(qsearchs);
+use FS::cust_bill;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+$lpr = $conf->config('lpr');
+
+#untaint invnum
+($query) = $cgi->keywords;
+$query =~ /^(\d*)$/;
+$invnum = $1;
+$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";
+
+$custnum = $cust_bill->getfield('custnum');
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history");
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $
+#
+# $Log: delete-customer.cgi,v $
+# Revision 1.1 1999-04-15 16:44:36 ivan
+# delete customers
+#
+
+use strict;
+use vars qw ( $cgi $conf $custnum $new_custnum $cust_main $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl);
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+die "Customer deletions not enabled" unless $conf->exists('deletecustomers');
+
+$cgi->param('custnum') =~ /^(\d+)$/;
+$custnum = $1;
+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 = '';
+}
+$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } )
+ or die "Customer not found: $custnum";
+
+$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
+#!/usr/bin/perl -Tw
+#
+# $Id: link.cgi,v 1.6 2000-07-17 17:59:33 ivan Exp $
+#
+# 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
+#
+# $Log: link.cgi,v $
+# Revision 1.6 2000-07-17 17:59:33 ivan
+# oops
+#
+# Revision 1.5 1999/04/15 14:09:17 ivan
+# get rid of top-level my() variables
+#
+# Revision 1.4 1999/02/07 09:59:35 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.3 1999/01/19 05:14:10 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:15:00 ivan
+# s/CGI::Request/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi $old $new $error $pkgnum $svcpart $svcnum );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::CGI qw(popurl idiot eidiot);
+use FS::UID qw(cgisuidsetup);
+use FS::cust_svc;
+use FS::Record qw(qsearchs);
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$cgi->param('pkgnum') =~ /^(\d+)$/;
+$pkgnum = $1;
+$cgi->param('svcpart') =~ /^(\d+)$/;
+$svcpart = $1;
+$cgi->param('svcnum') =~ /^(\d*)$/;
+$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_acct)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') });
+ eidiot("$link_field not found!") unless $svc_acct;
+ $svcnum=$svc_acct->svcnum;
+}
+
+$old = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+die "svcnum not found!" unless $old;
+$new = new FS::cust_svc ({
+ 'svcnum' => $svcnum,
+ 'pkgnum' => $pkgnum,
+ 'svcpart' => $svcpart,
+});
+
+$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 {
+ idiot($error);
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: susp_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $
+#
+# Usage: susp_pkg.cgi pkgnum
+# http://server.name/path/susp_pkg.cgi pkgnum
+#
+# 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
+#
+# $Log: susp_pkg.cgi,v $
+# Revision 1.6 1999-04-08 10:35:02 ivan
+# import necessary subroutines from FS::CGI
+#
+# Revision 1.5 1999/02/28 00:03:52 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:08 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:04:56 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:48 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs);
+use FS::CGI qw(popurl eidiot);
+use FS::cust_pkg;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#untaint pkgnum
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
+
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+
+$error = $cust_pkg->suspend;
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: unsusp_pkg.cgi,v 1.5 1999-02-28 00:03:53 ivan Exp $
+#
+# Usage: susp_pkg.cgi pkgnum
+# http://server.name/path/susp_pkg.cgi pkgnum
+#
+# 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
+#
+# $Log: unsusp_pkg.cgi,v $
+# Revision 1.5 1999-02-28 00:03:53 ivan
+# removed misleading comments
+#
+# Revision 1.4 1999/01/19 05:14:09 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:05:25 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:12:49 ivan
+# s/CGI::(Request|Base)/CGI.pm/;
+#
+
+use strict;
+use vars qw( $cgi $query $pkgnum $cust_pkg $error );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl eidiot);
+use FS::Record qw(qsearchs);
+use FS::cust_pkg;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#untaint pkgnum
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal pkgnum";
+$pkgnum = $1;
+
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+
+$error = $cust_pkg->unsuspend;
+&eidiot($error) if $error;
+
+print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_bill.cgi,v 1.6 2001-04-22 01:38:39 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/cust_bill.cgi
+#
+# ivan@voicenet.com 97-apr-4
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: cust_bill.cgi,v $
+# Revision 1.6 2001-04-22 01:38:39 ivan
+# svc_domain needs to import dbh sub from Record
+# view/cust_main.cgi needs to use ->owed method, not check (depriciated) owed field
+# search/cust_bill.cgi redirect error when there's only one invoice
+#
+# Revision 1.5 2000/07/17 16:45:41 ivan
+# first shot at invoice browsing and some other cleanups
+#
+# Revision 1.4 1999/02/28 00:03:54 ivan
+# removed misleading comments
+#
+# Revision 1.3 1999/01/19 05:14:11 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.2 1998/12/17 09:41:07 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi $invnum $query $sortby @cust_bill );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use Date::Format;
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl header menubar eidiot table );
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_bill;
+use FS::cust_main;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+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*$/;
+ $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 ) {
+ eidiot("Invoice not found.");
+} else {
+ my $total = scalar(@cust_bill);
+ print $cgi->header( '-expires' => 'now' ),
+ &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);
+ foreach $cust_bill (
+ sort $sortby grep(!$saw{$_->invnum}++, @cust_bill)
+ ) {
+ my($invnum, $owed, $charged, $date ) = (
+ $cust_bill->invnum,
+ $cust_bill->owed,
+ $cust_bill->charged,
+ $cust_bill->_date,
+ );
+ my $pdate = time2str("%b %d %Y", $date);
+
+ 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><A HREF="$view"><FONT SIZE=-1>\$$owed</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><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>";
+ }
+
+ 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;
+}
<HEAD>
<TITLE>Customer Search</TITLE>
</HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
+ <BODY BGCOLOR="#ffffff">
+ <FONT COLOR="#ff0000" SIZE=7>
+ Customer Search
+ </FONT>
+ <BR>
<FORM ACTION="cust_main.cgi" METHOD="post">
Search for <B>Credit card #</B>:
<INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE">
<P><INPUT TYPE="submit" VALUE="Search">
</FORM>
- <HR>
</BODY>
</HTML>
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main.cgi,v 1.17 2001-04-23 16:07:54 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/cust_main.cgi
+#
+# 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
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.17 2001-04-23 16:07:54 ivan
+# fix
+# Insecure dependency in eval while running with -T switch at /usr/local/lib/site_perl/FS/Record.pm line 202.
+#
+# Revision 1.16 2001/02/07 19:45:45 ivan
+# tyop
+#
+# Revision 1.15 2000/07/17 16:45:41 ivan
+# first shot at invoice browsing and some other cleanups
+#
+# Revision 1.14 1999/08/12 04:45:21 ivan
+# typo - missed a paren
+#
+# Revision 1.13 1999/08/12 04:32:21 ivan
+# hidecancelledcustomers
+#
+# Revision 1.12 1999/07/17 10:38:52 ivan
+# scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
+# gave me a great bugreport at the last rhythmethod
+#
+# Revision 1.11 1999/04/09 04:22:34 ivan
+# also table()
+#
+# Revision 1.10 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.9 1999/02/28 00:03:55 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/07 09:59:36 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.7 1999/01/25 12:19:11 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:14:12 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:37 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/30 00:57:50 ivan
+# bug
+#
+# Revision 1.3 1998/12/17 09:41:08 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/11/12 08:10:22 ivan
+# CGI.pm instead of CGI-modules
+# relative URLs using popurl
+# got rid of lots of little tables
+# s/agrep/String::Approx/;
+# bubble up packages and services and link (slow)
+#
+
+use strict;
+#use vars qw( $conf %ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby );
+use vars qw( $conf %all_pkgs $cgi @cust_main $sortby );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use IO::Handle;
+use String::Approx qw(amatch);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header menubar eidiot popurl table);
+use FS::cust_main;
+use FS::cust_svc;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+
+if ( $cgi->keywords ) {
+ my($query)=$cgi->keywords;
+ if ( $query eq 'custnum' ) {
+ $sortby=\*custnum_sort;
+ @cust_main=qsearch('cust_main',{});
+ } elsif ( $query eq 'last' ) {
+ $sortby=\*last_sort;
+ @cust_main=qsearch('cust_main',{});
+ } elsif ( $query eq 'company' ) {
+ $sortby=\*company_sort;
+ @cust_main=qsearch('cust_main',{});
+ } else {
+ die "unknown query string $query";
+ }
+} else {
+ @cust_main=();
+ &cardsearch if ( $cgi->param('card_on') && $cgi->param('card') );
+ &lastsearch if ( $cgi->param('last_on') && $cgi->param('last_text') );
+ &companysearch if ( $cgi->param('company_on') && $cgi->param('company_text') );
+}
+
+@cust_main = grep { $_->ncancelled_pkgs || ! $_->all_pkgs } @cust_main
+ if $conf->exists('hidecancelledcustomers');
+if ( $conf->exists('hidecancelledpackages' ) ) {
+ %all_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main;
+} else {
+ %all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main;
+}
+
+if ( scalar(@cust_main) == 1 ) {
+ print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum);
+ exit;
+} elsif ( scalar(@cust_main) == 0 ) {
+ eidiot "No matching customers found!\n";
+} else {
+
+ my($total)=scalar(@cust_main);
+ print $cgi->header( '-expires' => 'now' ), header("Customer Search Results",menubar(
+ 'Main Menu', popurl(2)
+ )), "$total matching customers found<BR>", &table(), <<END;
+ <TR>
+ <TH></TH>
+ <TH>Contact name</TH>
+ <TH>Company</TH>
+ <TH>Packages</TH>
+ <TH COLSPAN=2>Services</TH>
+ </TR>
+END
+
+ 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,
+ );
+
+ my(@lol_cust_svc);
+ my($rowspan)=0;#scalar( @{$all_pkgs{$custnum}} );
+ foreach ( @{$all_pkgs{$custnum}} ) {
+ my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
+ push @lol_cust_svc, \@cust_svc;
+ $rowspan += scalar(@cust_svc) || 1;
+ }
+
+ #my($rowspan) = scalar(@{$all_pkgs{$custnum}});
+ my($view) = popurl(2). "view/cust_main.cgi?$custnum";
+ print <<END;
+ <TR>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$custnum</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$last, $first</FONT></A></TD>
+ <TD ROWSPAN=$rowspan><A HREF="$view"><FONT SIZE=-1>$company</FONT></A></TD>
+END
+
+ my($n1)='';
+ foreach ( @{$all_pkgs{$custnum}} ) {
+ my($pkgnum) = ($_->pkgnum);
+ my($pkg) = $_->part_pkg->pkg;
+ my $comment = $_->part_pkg->comment;
+ my($pkgview) = popurl(2). "/view/cust_pkg.cgi?$pkgnum";
+ #my(@cust_svc) = shift @lol_cust_svc;
+ my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } );
+ my($rowspan) = scalar(@cust_svc) || 1;
+
+ print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview"><FONT SIZE=-1>$pkg - $comment</FONT></A></TD>!;
+ my($n2)='';
+ foreach my $cust_svc ( @cust_svc ) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ my($svcnum) = $cust_svc->svcnum;
+ my($sview) = popurl(2). "/view";
+ print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!,
+ qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!;
+ $n2="</TR><TR>";
+ }
+ #print qq!</TR><TR>\n!;
+ $n1="</TR><TR>";
+ }
+ print "</TR>";
+ }
+
+ print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+}
+
+#
+
+sub last_sort {
+ $a->getfield('last') cmp $b->getfield('last');
+}
+
+sub company_sort {
+ return -1 if $a->company && ! $b->company;
+ return 1 if ! $a->company && $b->company;
+ $a->getfield('company') cmp $b->getfield('company');
+}
+
+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;
+
+ push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
+
+}
+
+sub lastsearch {
+ my(%last_type);
+ 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'}
+ # && ! $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'}) {
+ foreach ( amatch($last, [ qw(i) ], @all_last) ) {
+ $last{$_}++;
+ }
+ }
+
+ #if ($last_type{'Sound-alike'}) {
+ #}
+
+ foreach ( keys %last ) {
+ push @cust_main, qsearch('cust_main',{'last'=>$_});
+ }
+
+ }
+ $sortby=\*last_sort;
+}
+
+sub companysearch {
+
+ my(%company_type);
+ 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'}
+ # && ! $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'}) {
+ foreach ( amatch($company, [ qw(i) ], @all_company ) ) {
+ $company{$_}++;
+ }
+ }
+
+ #if ($company_type{'Sound-alike'}) {
+ #}
+
+ foreach ( keys %company ) {
+ push @cust_main, qsearch('cust_main',{'company'=>$_});
+ }
+
+ }
+ $sortby=\*company_sort;
+
+}
<HEAD>
<TITLE>Customer Search</TITLE>
</HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
+ <BODY BGCOLOR="#ffffff">
+ <FONT COLOR="#ff0000" SIZE=7>
+ Customer Search
+ </FONT>
+ <BR>
<FORM ACTION="cust_main.cgi" METHOD="post">
- <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>:
+ <INPUT TYPE="checkbox" NAME="last_on" CHECKED> Search for <B>last name</B>:
<INPUT TYPE="text" NAME="last_text">
- using search method(s): <SELECT NAME="last_type" MULTIPLE>
+ using search method: <SELECT NAME="last_type">
<OPTION SELECTED>Fuzzy
<OPTION>Exact
</SELECT>
- <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>:
+ <P><INPUT TYPE="checkbox" NAME="company_on" CHECKED> Search for <B>company</B>:
<INPUT TYPE="text" NAME="company_text">
- using search methods(s): <SELECT NAME="company_type" MULTIPLE>
+ using search methods: <SELECT NAME="company_type">
<OPTION SELECTED>Fuzzy
<OPTION>Exact
</SELECT>
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_pkg.cgi,v 1.11 2000-07-17 16:45:41 ivan Exp $
+#
+# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.11 2000-07-17 16:45:41 ivan
+# first shot at invoice browsing and some other cleanups
+#
+# Revision 1.10 2000/07/17 12:49:29 ivan
+# better error message if a package isn't linked to a customer (that shouldn't happen)
+#
+# Revision 1.9 1999/07/17 10:38:52 ivan
+# scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
+# gave me a great bugreport at the last rhythmethod
+#
+# Revision 1.8 1999/02/09 09:22:57 ivan
+# visual and bugfixes
+#
+# Revision 1.7 1999/02/07 09:59:37 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:14:13 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:38 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1999/01/18 09:22:33 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.3 1998/12/23 03:05:59 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:41:09 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi @cust_pkg $sortby $query );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header eidiot popurl);
+use FS::cust_pkg;
+use FS::pkg_svc;
+use FS::cust_svc;
+use FS::cust_main;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+($query) = $cgi->keywords;
+#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;
+ @cust_pkg=();
+ #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;
+ print $cgi->redirect(popurl(2). "view/cust_pkg.cgi?$pkgnum");
+ exit;
+} elsif ( scalar(@cust_pkg) == 0 ) { #error
+ eidiot("No packages found");
+} else {
+ my($total)=scalar(@cust_pkg);
+ print $cgi->header( '-expires' => 'now' ), header('Package Search Results',''), <<END;
+ $total matching packages found
+ <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
+ <TR>
+ <TH>Package #</TH>
+ <TH>Customer #</TH>
+ <TH>Contact name</TH>
+ <TH>Company</TH>
+ </TR>
+END
+
+ 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_pkg->custnum,
+ $cust_main ? $cust_main->last. ', '. $cust_main->first : '',
+ $cust_main ? $cust_main->company : '',
+ );
+ my $p = popurl(2);
+ print <<END;
+ <TR>
+ <TD><A HREF="${p}view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
+END
+ if ( $cust_main ) {
+ print <<END;
+ <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$custnum</A></FONT></TD>
+ <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$name</A></FONT></TD>
+ <TD><FONT SIZE=-1><A HREF="${p}view/cust_main.cgi?$custnum">$company</A></FONT></TD>
+ </TR>
+END
+ } else {
+ print <<END;
+ <TD COLSPAN=3>WARNING: couldn't find cust_main.custnum $custnum (cust_pkg.pkgnum $pkgnum)</TD>
+ </TR>
+END
+ }
+ }
+
+ print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+ exit;
+
+}
+
+sub pkgnum_sort {
+ $a->getfield('pkgnum') <=> $b->getfield('pkgnum');
+}
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct.cgi,v 1.11 1999-04-14 11:25:33 ivan Exp $
+#
+# 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
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.11 1999-04-14 11:25:33 ivan
+# *** empty log message ***
+#
+# Revision 1.10 1999/04/14 11:20:21 ivan
+# visual fix
+#
+# Revision 1.9 1999/04/10 01:53:18 ivan
+# oops, search usernames limited to 8 chars
+#
+# Revision 1.8 1999/04/09 23:43:29 ivan
+# just in case
+#
+# Revision 1.7 1999/02/07 09:59:38 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:14:14 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:39 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1999/01/18 09:22:34 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.3 1998/12/23 03:06:28 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:41:10 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+
+use strict;
+use vars qw( $cgi @svc_acct $sortby $query );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header eidiot popurl table);
+use FS::svc_acct;
+use FS::cust_main;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+($query)=$cgi->keywords;
+$query ||= ''; #to avoid use of unitialized value errors
+#this tree is a little bit redundant
+if ( $query eq 'svcnum' ) {
+ $sortby=\*svcnum_sort;
+ @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 {
+ $sortby=\*uid_sort;
+ &usernamesearch;
+}
+
+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
+ eidiot("Account not found");
+} else {
+ my($total)=scalar(@svc_acct);
+ print $cgi->header( '-expires' => 'now' ),
+ header("Account Search Results",''),
+ "$total matching accounts found",
+ &table(), <<END;
+ <TR>
+ <TH><FONT SIZE=-1>Service #</FONT></TH>
+ <TH><FONT SIZE=-1>Username</FONT></TH>
+ <TH><FONT SIZE=-1>UID</FONT></TH>
+ <TH><FONT SIZE=-1>Service</FONT></TH>
+ <TH><FONT SIZE=-1>Customer #</FONT></TH>
+ <TH><FONT SIZE=-1>Contact name</FONT></TH>
+ <TH><FONT SIZE=-1>Company</FONT></TH>
+ </TR>
+END
+
+ 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($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>" : '';
+ 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><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>
+ </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 {
+
+ $cgi->param('username') =~ /^([\w\d\-]+)$/; #untaint username_text
+ my($username)=$1;
+
+ @svc_acct=qsearch('svc_acct',{'username'=>$username});
+
+}
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_sm.cgi,v 1.10 1999-07-20 06:03:36 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/svc_domain.cgi
+#
+# 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
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.10 1999-07-20 06:03:36 ivan
+# s/CGI::Request/CGI/; (how'd i miss that before?)
+#
+# Revision 1.9 1999/04/09 04:22:34 ivan
+# also table()
+#
+# Revision 1.8 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.7 1999/02/28 00:03:56 ivan
+# removed misleading comments
+#
+# Revision 1.6 1999/02/09 09:22:58 ivan
+# visual and bugfixes
+#
+# Revision 1.5 1999/01/19 05:14:16 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.4 1999/01/18 09:41:40 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.3 1998/12/17 09:41:11 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+
+use strict;
+use vars qw( $conf $cgi $mydomain $domuser $svc_domain $domsvc @svc_acct_sm );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl idiot header table);
+use FS::Record qw(qsearch qsearchs);
+use FS::Conf;
+use FS::svc_domain;
+use FS::svc_acct_sm;
+use FS::svc_acct;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+$cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
+$domuser = $1;
+
+$cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
+$svc_domain = qsearchs('svc_domain',{'domain'=>$1})
+ or die "Unknown domain";
+$domsvc = $svc_domain->svcnum;
+
+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 ) {
+ print $cgi->header( '-expires' => 'now' ),
+ 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
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_domain.cgi,v 1.11 2000-03-03 18:22:44 ivan Exp $
+#
+# Usage: post form to:
+# http://server.name/path/svc_domain.cgi
+#
+# 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
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.11 2000-03-03 18:22:44 ivan
+# changes from 1.2.3 release, fixes from webdemo
+#
+# Revision 1.10 1999/07/17 10:38:52 ivan
+# scott nelson <scott@ultimanet.com> noticed this mod_perl-triggered bug and
+# gave me a great bugreport at the last rhythmethod
+#
+# Revision 1.9 1999/04/15 13:39:16 ivan
+# $cgi->header( '-expires' => 'now' )
+#
+# Revision 1.8 1999/02/28 00:03:57 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/02/23 08:09:24 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.6 1999/02/09 09:22:59 ivan
+# visual and bugfixes
+#
+# Revision 1.5 1999/02/07 09:59:39 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.4 1999/01/19 05:14:17 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.3 1998/12/23 03:06:50 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:41:12 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi @svc_domain $sortby $query $conf $mydomain );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::CGI qw(header eidiot popurl);
+use FS::svc_domain;
+use FS::cust_svc;
+use FS::svc_acct_sm;
+use FS::svc_acct;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+($query)=$cgi->keywords;
+$query ||= ''; #to avoid use of unitialized value errors
+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 ) {
+ eidiot "No matching domains found!\n";
+} else {
+
+ my($total)=scalar(@svc_domain);
+ print $cgi->header( '-expires' => 'now' ),
+ 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 mail alias)</FONT></TH>
+ <TH>Forwards to<BR><FONT SIZE=-1>(click to view account)</FONT></TH>
+ </TR>
+END
+
+ my(%saw,$svc_domain);
+ my $p = popurl(2);
+ 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='';
+ #}
+
+ my @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $svcnum});
+ my $rowspan = scalar(@svc_acct_sm) || 1;
+
+ 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
+
+ my $n1 = '';
+ # false laziness: this was stolen from search/svc_acct_sm.cgi. but the
+ # web interface in general needs to be rewritten in a mucho cleaner way
+ my($svc_acct_sm);
+ foreach $svc_acct_sm (@svc_acct_sm) {
+ my($svcnum,$domuser,$domuid,$domsvc)=(
+ $svc_acct_sm->svcnum,
+ $svc_acct_sm->domuser,
+ $svc_acct_sm->domuid,
+ $svc_acct_sm->domsvc,
+ );
+ #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } );
+ #if ( $svc_domain ) {
+ # my $domain = $svc_domain->domain;
+
+ print qq!$n1<TD><A HREF="!. popurl(2). qq!view/svc_acct_sm.cgi?$svcnum">!,
+ #print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
+ ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ),
+ qq!\@$domain</A> </TD>!,
+ ;
+ #} else {
+ # my $warning = "couldn't find svc_domain.svcnum $svcnum ( svc_acct_sm.svcnum $svcnum";
+ # warn $warning;
+ # print "$n1<TD>WARNING: $warning</TD>";
+ #}
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $domuid } );
+ if ( $svc_acct ) {
+ my $username = $svc_acct->username;
+ my $svc_acct_svcnum =$svc_acct->svcnum;
+ print qq!<TD><A HREF="!, popurl(2),
+ qq!view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A>!,
+ qq!</TD></TR>!
+ ;
+ } else {
+ my $warning = "couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum $svcnum)!";
+ warn $warning;
+ print "<TD>WARNING: $warning</TD>";
+ }
+ $n1 = "</TR><TR>";
+ }
+ #end of false laziness
+ print "</TR>";
+
+ }
+
+ print <<END;
+ </TABLE>
+ </BODY>
+</HTML>
+END
+
+}
+
+sub svcnum_sort {
+ $a->getfield('svcnum') <=> $b->getfield('svcnum');
+}
+
+sub domain_sort {
+ $a->getfield('domain') cmp $b->getfield('doimain');
+}
+
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_bill.cgi,v 1.8 1999-02-28 00:03:58 ivan Exp $
+#
+# this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice
+#
+# 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
+#
+# $Log: cust_bill.cgi,v $
+# Revision 1.8 1999-02-28 00:03:58 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/01/25 12:26:03 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.6 1999/01/19 05:14:18 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:42 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/30 23:03:33 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.3 1998/12/23 03:07:49 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.2 1998/12/17 09:57:20 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+
+use strict;
+use vars qw ( $cgi $query $invnum $cust_bill $custnum $printed $p );
+use IO::File;
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl menubar);
+use FS::Record qw(qsearchs);
+use FS::cust_bill;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+#untaint invnum
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$invnum = $1;
+
+$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum});
+die "Invoice #$invnum not found!" unless $cust_bill;
+$custnum = $cust_bill->getfield('custnum');
+
+$printed = $cust_bill->printed;
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Invoice View', menubar(
+ "Main Menu" => $p,
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+)), <<END;
+ <A HREF="${p}edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A>
+ <BR><A HREF="${p}misc/print-invoice.cgi?$invnum">Reprint this invoice</A>
+ <BR><BR>(Printed $printed times)
+ <PRE>
+END
+
+print $cust_bill->print_text;
+
+ #formatting
+ print <<END;
+ </PRE></FONT>
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: cust_main.cgi,v 1.20 2001-06-03 11:40:48 ivan Exp $
+#
+# Usage: cust_main.cgi custnum
+# http://server.name/path/cust_main.cgi?custnum
+#
+# 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
+#
+# $Log: cust_main.cgi,v $
+# Revision 1.20 2001-06-03 11:40:48 ivan
+# inline doc clarification
+#
+# Revision 1.19 2001/04/22 01:38:39 ivan
+# svc_domain needs to import dbh sub from Record
+# view/cust_main.cgi needs to use ->owed method, not check (depriciated) owed field
+# search/cust_bill.cgi redirect error when there's only one invoice
+#
+# Revision 1.18 1999/08/12 04:16:01 ivan
+# hidecancelledpackages config option
+#
+# Revision 1.17 1999/04/15 16:44:36 ivan
+# delete customers
+#
+# Revision 1.16 1999/04/09 04:22:34 ivan
+# also table()
+#
+# Revision 1.15 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.14 1999/04/08 04:04:37 ivan
+# eliminate double // in links
+#
+# Revision 1.13 1999/02/28 00:04:00 ivan
+# removed misleading comments
+#
+# Revision 1.12 1999/02/07 09:59:40 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.11 1999/01/25 12:26:04 ivan
+# yet more mod_perl stuff
+#
+# Revision 1.10 1999/01/19 05:14:19 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.9 1999/01/18 09:41:43 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.8 1999/01/18 09:22:35 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.7 1998/12/30 23:03:34 ivan
+# bugfixes; fields isn't exported by derived classes
+#
+# Revision 1.6 1998/12/23 02:42:33 ivan
+# remove double '/' in link urls
+#
+# Revision 1.5 1998/12/23 02:36:28 ivan
+# use FS::cust_refund; to eliminate warning
+#
+# Revision 1.4 1998/12/17 09:57:21 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.3 1998/11/15 13:14:20 ivan
+# first pass as per-customer custom pricing
+#
+# Revision 1.2 1998/11/13 11:28:08 ivan
+# s/CGI-modules/CGI.pm/;, relative URL's with popurl
+#
+
+use strict;
+use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral
+ @packages $package @history @bills $bill @credits $credit
+ $balance $item @agents @referrals @invoicing_list $n1 $conf );
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use Date::Format;
+use FS::UID qw(cgisuidsetup);
+use FS::Record qw(qsearchs qsearch);
+use FS::CGI qw(header menubar popurl table itable ntable);
+use FS::cust_credit;
+use FS::cust_pay;
+use FS::cust_bill;
+use FS::part_pkg;
+use FS::cust_pkg;
+use FS::part_referral;
+use FS::agent;
+use FS::cust_main;
+use FS::cust_refund;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+
+print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar(
+ 'Main Menu' => popurl(2)
+));
+
+die "No customer specified (bad URL)!" unless $cgi->keywords;
+($query) = $cgi->keywords; # needs parens with my, ->keywords returns array
+$query =~ /^(\d+)$/;
+$custnum = $1;
+$cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
+die "Customer not found!" unless $cust_main;
+$hashref = $cust_main->hashref;
+
+print &itable(), '<TR><TD><A NAME="cust_main"></A>';
+
+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');
+print &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Customer number</TD><TD BGCOLOR="#ffffff">',
+ $custnum, '</TD></TR>',
+;
+
+@agents = qsearch( 'agent', {} );
+unless ( scalar(@agents) == 1 ) {
+ $agent = qsearchs('agent',{
+ 'agentnum' => $cust_main->agentnum
+ } );
+ print '<TR><TD ALIGN="right">Agent</TD><TD BGCOLOR="#ffffff">',
+ $agent->agentnum, ": ", $agent->agent, '</TD></TR>';
+}
+@referrals = qsearch( 'part_referral', {} );
+unless ( scalar(@referrals) == 1 ) {
+ my $referral = qsearchs('part_referral', {
+ 'refnum' => $cust_main->refnum
+ } );
+ print '<TR><TD ALIGN="right">Referral</TD><TD BGCOLOR="#ffffff">',
+ $referral->refnum, ": ", $referral->referral, '</TD></TR>';
+}
+print '<TR><TD ALIGN="right">Order taker</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->otaker, '</TD></TR>';
+
+print '</TABLE></TD></TR></TABLE>';
+
+print '</TD><TD ROWSPAN=2>';
+
+print "Contact information", &ntable("#c0c0c0"), "<TR><TD>",
+ &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Contact name<BR>(last, first)</TD>',
+ '<TD COLSPAN=3 BGCOLOR="#ffffff">',
+ $cust_main->last, ', ', $cust_main->first,
+ '</TD><TD ALIGN="right">SS#</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->ss || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Company</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->company,
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Address</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->address1,
+ '</TD></TR>',
+;
+print '<TR><TD ALIGN="right"> </TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->address2, '</TD></TR>'
+ if $cust_main->address2;
+print '<TR><TD ALIGN="right">City</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->city,
+ '</TD><TD ALIGN="right">State</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->state,
+ '</TD><TD ALIGN="right">Zip</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->zip, '</TD></TR>',
+ '<TR><TD ALIGN="right">Country</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->country,
+ '</TD></TR>',
+;
+print '<TR><TD ALIGN="right">Day Phone</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->daytime || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Night Phone</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->night || ' ', '</TD></TR>',
+ '<TR><TD ALIGN="right">Fax</TD><TD COLSPAN=5 BGCOLOR="#ffffff">',
+ $cust_main->fax || ' ', '</TD></TR>',
+ '</TABLE>', "</TD></TR></TABLE>"
+;
+
+print '</TD></TR><TR><TD>';
+
+@invoicing_list = $cust_main->invoicing_list;
+print "Billing information (",
+ qq!<A HREF="!, popurl(2), qq!/misc/bill.cgi?$custnum">!, "Bill now</A>)",
+ &ntable("#c0c0c0"), "<TR><TD>", &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Tax exempt</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->tax ? 'yes' : 'no',
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Postal invoices</TD><TD BGCOLOR="#ffffff">',
+ ( grep { $_ eq 'POST' } @invoicing_list ) ? 'yes' : 'no',
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Email invoices</TD><TD BGCOLOR="#ffffff">',
+ join(', ', grep { $_ ne 'POST' } @invoicing_list ) || 'no',
+ '</TD></TR>',
+ '<TR><TD ALIGN="right">Billing type</TD><TD BGCOLOR="#ffffff">',
+;
+
+if ( $cust_main->payby eq 'CARD' ) {
+ print 'Credit card</TD></TR>',
+ '<TR><TD ALIGN="right">Card number</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payinfo, '</TD></TR>',
+ '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->paydate, '</TD></TR>',
+ '<TR><TD ALIGN="right">Name on card</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payname, '</TD></TR>'
+ ;
+} elsif ( $cust_main->payby eq 'BILL' ) {
+ print 'Billing</TD></TR>';
+ print '<TR><TD ALIGN="right">P.O. </TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payinfo, '</TD></TR>',
+ if $cust_main->payinfo;
+ print '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->paydate, '</TD></TR>',
+ '<TR><TD ALIGN="right">Attention</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payname, '</TD></TR>',
+ ;
+} elsif ( $cust_main->payby eq 'COMP' ) {
+ print 'Complimentary</TD></TR>',
+ '<TR><TD ALIGN="right">Authorized by</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->payinfo, '</TD></TR>',
+ '<TR><TD ALIGN="right">Expiration</TD><TD BGCOLOR="#ffffff">',
+ $cust_main->paydate, '</TD></TR>',
+ ;
+}
+
+print "</TABLE></TD></TR></TABLE></TD></TR></TABLE>";
+
+print qq!<BR><BR><A NAME="cust_pkg">Packages</A> !,
+# qq!<BR>Click on package number to view/edit package.!,
+ qq!( <A HREF="!, popurl(2), qq!edit/cust_pkg.cgi?$custnum">Order and cancel packages</A> (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
+if ( $conf->exists('hidecancelledpackages') ) {
+ @packages = $cust_main->ncancelled_pkgs;
+} else {
+ @packages = $cust_main->all_pkgs;
+}
+
+$n1 = '<TR>';
+foreach $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 $button_cgi = new CGI;
+ $button_cgi->param('clone', $package->part_pkg->pkgpart);
+ $button_cgi->param('pkgnum', $package->pkgnum);
+ my $button_url = popurl(2). "edit/part_pkg.cgi?". $button_cgi->query_string;
+
+ #print $n1, qq!<TD ROWSPAN=$rowspan><A HREF="$pkgview">$pkgnum</A></TD>!,
+ print $n1, qq!<TD ROWSPAN=$rowspan>$pkgnum</TD>!,
+ qq!<TD ROWSPAN=$rowspan><FONT SIZE=-1>!,
+ #qq!<A HREF="$pkgview">$pkg - $comment</A>!,
+ qq!$pkg - $comment!,
+ qq! ( <A HREF="$pkgview">Edit</A> | <A HREF="$button_url">Customize pricing</A> )</FONT></TD>!,
+ ;
+ for ( qw( setup bill susp expire cancel ) ) {
+ print "<TD ROWSPAN=$rowspan><FONT SIZE=-1>", ( $package->getfield($_)
+ ? time2str("%D", $package->getfield($_) )
+ : ' '
+ ), '</FONT></TD>',
+ ;
+ }
+
+ my $n2 = '';
+ foreach my $cust_svc ( @cust_svc ) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ my($svcnum) = $cust_svc->svcnum;
+ my($sview) = popurl(2). "view";
+ print $n2,qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$label</FONT></A></TD>!,
+ qq!<TD><A HREF="$sview/$svcdb.cgi?$svcnum"><FONT SIZE=-1>$value</FONT></A></TD>!;
+ $n2="</TR><TR>";
+ }
+ $n1="</TR><TR>";
+}
+print "</TR>";
+
+#formatting
+print "</TABLE>";
+
+#formatting
+print qq!<BR><BR><A NAME="history">Payment History!,
+ qq!</A>!,
+ qq! ( Click on invoice to view invoice/enter payment. | !,
+ qq!<A HREF="!, popurl(2), qq!edit/cust_credit.cgi?$custnum">!,
+ qq!Post credit / refund</A> )!;
+
+#get payment history
+#
+# major problem: this whole thing is way too sloppy.
+# minor problem: the description lines need better formatting.
+
+@history = (); #needed for mod_perl :)
+
+@bills = qsearch('cust_bill',{'custnum'=>$custnum});
+foreach $bill (@bills) {
+ my($bref)=$bill->hashref;
+ push @history,
+ $bref->{_date} . qq!\t<A HREF="!. popurl(2). qq!view/cust_bill.cgi?! .
+ $bref->{invnum} . qq!">Invoice #! . $bref->{invnum} .
+ qq! (Balance \$! . $bill->owed . qq!)</A>\t! .
+ $bref->{charged} . qq!\t\t\t!;
+
+ my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } );
+ my($payment);
+ foreach $payment (@payments) {
+ 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";
+ }
+}
+
+@credits = qsearch('cust_credit',{'custnum'=>$custnum});
+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 &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
+
+$balance = 0;
+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>";
+
+#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
+#
+# $Id: cust_pkg.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $
+#
+# Usage: cust_pkg.cgi pkgnum
+# http://server.name/path/cust_pkg.cgi?pkgnum
+#
+# 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
+#
+# $Log: cust_pkg.cgi,v $
+# Revision 1.11 1999-04-09 04:22:34 ivan
+# also table()
+#
+# Revision 1.10 1999/04/09 03:52:55 ivan
+# explicit & for table/itable/ntable
+#
+# Revision 1.9 1999/04/08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.8 1999/02/28 00:04:01 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/01/19 05:14:20 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:44 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1998/12/23 03:11:40 ivan
+# *** empty log message ***
+#
+# Revision 1.3 1998/12/17 09:57:22 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/11/13 09:56:49 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
+
+use strict;
+use vars qw ( $cgi %uiview %uiadd $part_svc $query $pkgnum $cust_pkg $part_pkg
+ $custnum $susp $cancel $expire $pkg $comment $setup $bill
+ $otaker );
+use Date::Format;
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(popurl header menubar ntable table);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_svc;
+use FS::cust_pkg;
+use FS::part_pkg;
+use FS::pkg_svc;
+use FS::cust_svc;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+foreach $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";
+}
+
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$pkgnum = $1;
+
+#get package record
+$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+die "No package!" unless $cust_pkg;
+$part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
+
+$custnum = $cust_pkg->getfield('custnum');
+print $cgi->header( '-expires' => 'now' ), header('Package View', menubar(
+ "View this customer (#$custnum)" => popurl(2). "view/cust_main.cgi?$custnum",
+ 'Main Menu' => popurl(2)
+));
+
+#print info
+($susp,$cancel,$expire)=(
+ $cust_pkg->getfield('susp'),
+ $cust_pkg->getfield('cancel'),
+ $cust_pkg->getfield('expire'),
+);
+($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
+($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
+$otaker = $cust_pkg->getfield('otaker');
+
+print "Package information";
+print ' (<A HREF="'. popurl(2). 'misc/unsusp_pkg.cgi?'. $pkgnum.
+ '">unsuspend</A>)' if ( $susp && ! $cancel );
+print ' (<A HREF="'. popurl(2). 'misc/susp_pkg.cgi?'. $pkgnum.
+ '">suspend</A>)' unless ( $susp || $cancel );
+print ' (<A HREF="'. popurl(2). 'misc/cancel_pkg.cgi?'. $pkgnum.
+ '">cancel</A>)' unless $cancel;
+
+print &ntable("#c0c0c0"), '<TR><TD>', &ntable("#c0c0c0",2),
+ '<TR><TD ALIGN="right">Package number</TD><TD BGCOLOR="#ffffff">',
+ $pkgnum, '</TD></TR>',
+ '<TR><TD ALIGN="right">Package</TD><TD BGCOLOR="#ffffff">',
+ $pkg, '</TD></TR>',
+ '<TR><TD ALIGN="right">Comment</TD><TD BGCOLOR="#ffffff">',
+ $comment, '</TD></TR>',
+ '<TR><TD ALIGN="right">Setup date</TD><TD BGCOLOR="#ffffff">',
+ ( $setup ? time2str("%D",$setup) : "(Not setup)" ), '</TD></TR>',
+ '<TR><TD ALIGN="right">Next bill date</TD><TD BGCOLOR="#ffffff">',
+ ( $bill ? time2str("%D",$bill) : " " ), '</TD></TR>',
+;
+print '<TR><TD ALIGN="right">Suspension date</TD><TD BGCOLOR="#ffffff">',
+ time2str("%D",$susp), '</TD></TR>' if $susp;
+print '<TR><TD ALIGN="right">Expiration date</TD><TD BGCOLOR="#ffffff">',
+ time2str("%D",$expire), '</TD></TR>' if $expire;
+print '<TR><TD ALIGN="right">Cancellation date</TD><TD BGCOLOR="#ffffff">',
+ time2str("%D",$cancel), '</TD></TR>' if $cancel;
+print '<TR><TD ALIGN="right">Order taker</TD><TD BGCOLOR="#ffffff">',
+ $otaker, '</TD></TR>',
+ '</TABLE></TD></TR></TABLE>'
+;
+
+# print <<END;
+#<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post">
+#<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
+#Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" >
+#<INPUT TYPE="submit" VALUE="Cancel later">
+#END
+
+unless ($cancel) {
+
+ #services
+ print '<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) $svc: $value<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><FONT SIZE=-1>",
+ "Choose (View) to view or edit an existing service<BR>",
+ "Choose (Add) to setup a new service<BR>",
+ "Choose (Link to existing) to link to a legacy (pre-Freeside) service",
+ "</FONT>"
+ ;
+}
+
+#formatting
+print <<END;
+ </BODY>
+</HTML>
+END
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct.cgi,v 1.12 2001-01-31 07:21:00 ivan Exp $
+#
+# Usage: svc_acct.cgi svcnum
+# http://server.name/path/svc_acct.cgi?svcnum
+#
+# 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
+#
+# $Log: svc_acct.cgi,v $
+# Revision 1.12 2001-01-31 07:21:00 ivan
+# fix tyops
+#
+# Revision 1.11 2000/12/03 20:25:20 ivan
+# session monitor updates
+#
+# Revision 1.10 1999/04/14 11:27:06 ivan
+# showpasswords config option to show passwords
+#
+# Revision 1.9 1999/04/08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.8 1999/02/28 00:04:02 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/01/19 05:14:21 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.6 1999/01/18 09:41:45 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.5 1999/01/18 09:22:36 ivan
+# changes to track email addresses for email invoicing
+#
+# Revision 1.4 1998/12/23 03:09:19 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 09:57:23 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/12/16 05:24:29 ivan
+# use FS::Conf;
+#
+
+use strict;
+use vars qw( $conf $cgi $mydomain $query $svcnum $svc_acct $cust_svc $pkgnum
+ $cust_pkg $custnum $part_svc $p $svc_acct_pop $password );
+use CGI;
+use CGI::Carp qw( fatalsToBrowser );
+use FS::UID qw( cgisuidsetup );
+use FS::CGI qw( header popurl menubar);
+use FS::Record qw( qsearchs fields );
+use FS::Conf;
+use FS::svc_acct;
+use FS::cust_svc;
+use FS::cust_pkg;
+use FS::part_svc;
+use FS::svc_acct_pop;
+
+$cgi = new CGI;
+&cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_acct;
+
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$pkgnum = $cust_svc->getfield('pkgnum');
+if ($pkgnum) {
+ $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ $custnum=$cust_pkg->getfield('custnum');
+} else {
+ $cust_pkg = '';
+ $custnum = '';
+}
+
+$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
+die "Unknown svcpart" unless $part_svc;
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Account View', menubar(
+ ( ( $pkgnum || $custnum )
+ ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ )
+ : ( "Cancel this (unaudited) account" =>
+ "${p}misc/cancel-unaudited.cgi?$svcnum" )
+ ),
+ "Main menu" => $p,
+));
+
+#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>Service #$svcnum",
+ "<BR>Service: <B>", $part_svc->svc, "</B>",
+ "<BR><BR>Username: <B>", $svc_acct->username, "</B>"
+;
+
+print "<BR>Password: ";
+$password = $svc_acct->_password;
+if ( $password =~ /^\*\w+\* (.*)$/ ) {
+ $password = $1;
+ print "<I>(login disabled)</I> ";
+}
+if ( $conf->exists('showpasswords') ) {
+ print "<B>$password</B>";
+} else {
+ print "<I>(hidden)</I>";
+}
+$password = '';
+
+$svc_acct_pop = qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum});
+print "<BR>POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state,
+ " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "</B>"
+ if $svc_acct_pop;
+
+if ($svc_acct->uid ne '') {
+ print "<BR><BR>Uid: <B>", $svc_acct->uid, "</B>",
+ "<BR>Gid: <B>", $svc_acct->gid, "</B>",
+ "<BR>Finger name: <B>", $svc_acct->finger, "</B>",
+ "<BR>Home directory: <B>", $svc_acct->dir, "</B>",
+ "<BR>Shell: <B>", $svc_acct->shell, "</B>",
+ "<BR>Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>"
+ ;
+} else {
+ print "<BR><BR>(No shell account)";
+}
+
+if ($svc_acct->slipip) {
+ print "<BR><BR>IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>";
+ my($attribute);
+ foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
+ #warn $attribute;
+ $attribute =~ /^radius_(.*)$/;
+ my($pattribute) = ($1);
+ $pattribute =~ s/_/-/g;
+ print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>";
+ }
+} else {
+ print "<BR><BR>(No SLIP/PPP account)";
+}
+
+print "</BODY></HTML>";
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_acct_sm.cgi,v 1.11 2000-07-17 10:58:42 ivan Exp $
+#
+# Usage: svc_acct_sm.cgi svcnum
+# http://server.name/path/svc_acct_sm.cgi?svcnum
+#
+# 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
+#
+# $Log: svc_acct_sm.cgi,v $
+# Revision 1.11 2000-07-17 10:58:42 ivan
+# better error messages if svc_acct or svc_domain records are missing
+#
+# Revision 1.10 1999/04/08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.9 1999/02/28 00:04:03 ivan
+# removed misleading comments
+#
+# Revision 1.8 1999/02/09 09:23:00 ivan
+# visual and bugfixes
+#
+# Revision 1.7 1999/02/07 09:59:42 ivan
+# more mod_perl fixes, and bugfixes Peter Wemm sent via email
+#
+# Revision 1.6 1999/01/19 05:14:22 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:46 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/23 03:09:52 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 09:57:24 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/12/16 05:24:30 ivan
+# use FS::Conf;
+#
+
+use strict;
+use vars qw($conf $cgi $mydomain $query $svcnum $svc_acct_sm $cust_svc
+ $pkgnum $cust_pkg $custnum $part_svc $p $domsvc $domuid $domuser
+ $svc $svc_domain $domain $svc_acct $username );
+use CGI;
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header popurl menubar );
+use FS::Record qw(qsearchs);
+use FS::Conf;
+use FS::svc_acct_sm;
+use FS::cust_svc;
+use FS::cust_pkg;
+use FS::part_svc;
+use FS::svc_domain;
+use FS::svc_acct;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+$conf = new FS::Conf;
+$mydomain = $conf->config('domain');
+
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+$svc_acct_sm = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_acct_sm;
+
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$pkgnum = $cust_svc->getfield('pkgnum');
+if ($pkgnum) {
+ $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ $custnum=$cust_pkg->getfield('custnum');
+} else {
+ $cust_pkg = '';
+ $custnum = '';
+}
+
+$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } )
+ or die "Unkonwn svcpart";
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Mail Alias View', menubar(
+ ( ( $pkgnum || $custnum )
+ ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ )
+ : ( "Cancel this (unaudited) account" =>
+ "${p}misc/cancel-unaudited.cgi?$svcnum" )
+ ),
+ "Main menu" => $p,
+));
+
+($domsvc,$domuid,$domuser) = (
+ $svc_acct_sm->domsvc,
+ $svc_acct_sm->domuid,
+ $svc_acct_sm->domuser,
+);
+$svc = $part_svc->svc;
+$svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc})
+ or die "Corrupted database: no svc_domain.svcnum matching domsvc $domsvc";
+$domain = $svc_domain->domain;
+$svc_acct = qsearchs('svc_acct',{'uid'=>$domuid})
+ or die "Corrupted database: no svc_acct.uid matching domuid $domuid";
+$username = $svc_acct->username;
+
+print qq!<A HREF="${p}edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>!,
+ "<BR>Service #$svcnum",
+ "<BR>Service: <B>$svc</B>",
+ qq!<BR>Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!,
+ '</BODY></HTML>'
+;
+
--- /dev/null
+#!/usr/bin/perl -Tw
+#
+# $Id: svc_domain.cgi,v 1.11 2000-12-03 15:14:00 ivan Exp $
+#
+# Usage: svc_domain svcnum
+# http://server.name/path/svc_domain.cgi?svcnum
+#
+# ivan@voicenet.com 97-jan-6
+#
+# rewrite ivan@sisd.com 98-mar-14
+#
+# Changes to allow page to work at a relative position in server
+# bmccane@maxbaud.net 98-apr-3
+#
+# $Log: svc_domain.cgi,v $
+# Revision 1.11 2000-12-03 15:14:00 ivan
+# bugfixes from Jeff Finucane <jeff@cmh.net>, thanks!
+#
+# Revision 1.10 1999/08/27 22:18:44 ivan
+# point to patrick instead of internic!
+#
+# Revision 1.9 1999/04/08 12:00:19 ivan
+# aesthetic update
+#
+# Revision 1.8 1999/02/28 00:04:04 ivan
+# removed misleading comments
+#
+# Revision 1.7 1999/02/23 08:09:25 ivan
+# beginnings of one-screen new customer entry and some other miscellania
+#
+# Revision 1.6 1999/01/19 05:14:23 ivan
+# for mod_perl: no more top-level my() variables; use vars instead
+# also the last s/create/new/;
+#
+# Revision 1.5 1999/01/18 09:41:47 ivan
+# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
+# (good idea anyway)
+#
+# Revision 1.4 1998/12/23 03:10:19 ivan
+# $cgi->keywords instead of $cgi->query_string
+#
+# Revision 1.3 1998/12/17 09:57:25 ivan
+# s/CGI::(Base|Request)/CGI.pm/;
+#
+# Revision 1.2 1998/11/13 09:56:50 ivan
+# change configuration file layout to support multiple distinct databases (with
+# own set of config files, export, etc.)
+#
+
+use strict;
+use vars qw( $cgi $query $svcnum $svc_domain $domain $cust_svc $pkgnum
+ $cust_pkg $custnum $part_svc $p );
+use CGI;
+use FS::UID qw(cgisuidsetup);
+use FS::CGI qw(header menubar popurl menubar);
+use FS::Record qw(qsearchs);
+use FS::svc_domain;
+use FS::cust_svc;
+use FS::cust_pkg;
+use FS::part_svc;
+
+$cgi = new CGI;
+cgisuidsetup($cgi);
+
+($query) = $cgi->keywords;
+$query =~ /^(\d+)$/;
+$svcnum = $1;
+$svc_domain = qsearchs('svc_domain',{'svcnum'=>$svcnum});
+die "Unknown svcnum" unless $svc_domain;
+
+$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+$pkgnum = $cust_svc->getfield('pkgnum');
+if ($pkgnum) {
+ $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
+ $custnum=$cust_pkg->getfield('custnum');
+} else {
+ $cust_pkg = '';
+ $custnum = '';
+}
+
+$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
+die "Unkonwn svcpart" unless $part_svc;
+
+$domain = $svc_domain->domain;
+
+$p = popurl(2);
+print $cgi->header( '-expires' => 'now' ), header('Domain View', menubar(
+ ( ( $pkgnum || $custnum )
+ ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
+ "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
+ )
+ : ( "Cancel this (unaudited) account" =>
+ "${p}misc/cancel-unaudited.cgi?$svcnum" )
+ ),
+ "Main menu" => $p,
+)),
+ "Service #$svcnum",
+ "<BR>Service: <B>", $part_svc->svc, "</B>",
+ "<BR>Domain name: <B>$domain</B>.",
+ qq!<BR><BR><A HREF="http://www.geektools.com/cgi-bin/proxy.cgi?query=$domain;targetnic=auto">View whois information.</A>!,
+ '</BODY></HTML>',
+;
+++ /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
+#!/usr/bin/perl -Tw
+#
+# $Id: cgi-test,v 1.2 1999-08-23 12:26:37 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.)
+#
+# $Log: cgi-test,v $
+# Revision 1.2 1999-08-23 12:26:37 ivan
+# need to untaint the command line
+#
+# Revision 1.1 1999/04/08 13:05:40 ivan
+# web interface tester / sample data creator
+#
+
+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
