'freeside_1_2_3_pci_mods'.
Thanks to Matt Simerson <matt@michweb.net> of MichWeb Inc. for documentation
-and pre-release testing. Without his help the documentation in the first
+and pre-release testing. Without his help the documentation in 1.0.0
release would have consisted of a single screenfull of text.
+(To clear up some misunderstanding, Matt did not write the current
+documentation.)
-# Steve Cleff <cleff@yahoo.com> did the default background image and is also
-# the creator of Freeside's mascot, Snakeman.
+Steve Cleff <cleff@yahoo.com> did the default background image in 1.0.x and
+is also the creator of Freeside's elusive mascot, Snakeman, who we hope will
+make an appearance in an upcoming version.
-Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic.
+Jerry St. Pierre <jstpi@city.timmins.on.ca> did the "SISD" graphic used in
+1.0.x and most of 1.1.x.
+
+Mark Norris of Urban Design, Inc. <http://www.urban.com/> did the red "S"
+logo for later 1.1.x versions and 1.2.x
Brian McCane? <bmccane@maxbaud.net> contributed PostgreSQL support, HTML
style enhancements and many, many bugfixes.
-Everything else is my (Ivan Kohler <ivan@sisd.com>) fault.
+Cerkit <cerkit@alfheim.net> contributed rsync support and desynced hosts.
+His changes will hopefully be included in an upcoming version.
+
+CompleteHOST, Inc. (http://www.completehost.com) funded the development of the
+following features:
+ - Multiple, separate databases and configurations on one box.
+ - Per-customer pricing (custom packages)
+ - Internationalization wrt addresses (cust_main, cust_main_county)
+Thanks!
+
+Mark Williamson <mark.williamson@ebbs.com.au> and Roger Mangraviti
+<rem@atu.com.au> contributed state/provence listings for Australia.
+
+Peter Wemm <peter@netplex.com.au> sent in a bunch of bugfixes for the 1.2
+release.
+
+Greg Kuhnert <gregk@no1.com.au> sent some documentation updates.
+
+Joel Griffiths <griff@aver-computer.com> contribued many bugfixes, and offers
+invaluable help to users on the mailing list.
+
+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
+
+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 temporary prefix for many disparate modules written for the Freeside
+ISP billing software. This includes:
+
+=head2 Database metadata classes
+
+L<FS::dbdef> - Database class
+
+L<FS::dbdef_table> - Database table class
+
+L<FS::dbdef_column> - Database column class
+
+L<FS::dbdef_colgroup> - Database column group class
+
+L<FS::dbdef_index> - Database index class
+
+L<FS::dbdef_unique> - Database unique index class
+
+=head2 Utility classes
+
+L<FS::SSH> - Simple wrappers around ssh and scp commands.
+
+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::svc_acct_sm> - Vitual mail alias 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
+
+=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.3 1999-08-04 12:41:47 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.
+
+=cut
+
--- /dev/null
+package FS::Bill;
+
+use strict;
+use vars qw(@ISA);
+use FS::cust_main;
+
+@ISA = qw(FS::cust_main);
+
+warn "FS::Bill depriciated\n";
+
+=head1 NAME
+
+FS::Bill - Legacy stub
+
+=head1 SYNOPSIS
+
+The functionality of FS::Bill has been integrated into FS::cust_main.
+
+=cut
+
+1;
--- /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(@_);
+ 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->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::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::Invoice;
+
+use strict;
+use vars qw(@ISA);
+use FS::cust_bill;
+
+@ISA = qw(FS::cust_bill);
+
+warn "FS::Invoice depriciated\n";
+
+=head1 NAME
+
+FS::Invoice - Legacy stub
+
+=head1 SYNOPSIS
+
+The functionality of FS::Invoice has been integrated in FS::cust_bill.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::Record;
+
+use strict;
+use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK);
+use subs qw(reload_dbdef);
+use Exporter;
+use Carp qw(carp cluck croak confess);
+use File::CounterFile;
+use FS::UID qw(dbh checkruid swapuid getotaker datasrc);
+use FS::dbdef;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
+
+#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 ( datasrc =~ m/Pg/
+ && $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
+
+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.
+
+=cut
+
+sub qsearch {
+ my($table,$record) = @_;
+ my($dbh) = dbh;
+
+ my(@fields)=grep exists($record->{$_}), fields($table);
+
+ my($sth);
+ my($statement) = "SELECT * FROM $table". ( @fields
+ ? " WHERE ". join(' AND ',
+ map {
+ $record->{$_} eq ''
+ ? ( datasrc =~ m/Pg/
+ ? "$_ IS NULL"
+ : "( $_ IS NULL OR $_ = \"\" )"
+ )
+ : "$_ = ". _quote($record->{$_},$table,$_)
+ } @fields
+ ) : ''
+ );
+ $sth=$dbh->prepare($statement)
+ or croak $dbh->errstr; #is that a little too harsh? hmm.
+ #warn $statement #if $debug # or some such;
+
+ if ( eval ' scalar(@FS::'. $table. '::ISA);' ) {
+ map {
+ eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );';
+ } ( 1 .. $sth->execute );
+ } else {
+ cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects";
+ map {
+ new FS::Record ($table,$sth->fetchrow_hashref);
+ } ( 1 .. $sth->execute );
+ }
+
+}
+
+=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?
+ $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) ) {
+ $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;
+
+ '';
+}
+
+=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 $_ = \"\" )"
+ ? ( datasrc =~ m/Pg/
+ ? "$_ 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";
+
+ 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 $_ = \"\" )"
+ ? ( datasrc =~ m/Pg/
+ ? "$_ 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";
+
+ '';
+
+}
+
+=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<FS::dbdef_table>).
+Returns the new value.
+
+=cut
+
+sub unique {
+ my($self,$field) = @_;
+ my($table)=$self->table;
+
+ croak("&FS::UID::checkruid failed") unless &checkruid;
+
+ croak "Unique called on field $field, but it is ",
+ $self->getfield($field),
+ ", not null!"
+ if $self->getfield($field);
+
+ #warn "table $table is tainted" if is_tainted($table);
+ #warn "field $field is tainted" if is_tainted($field);
+
+ &swapuid;
+ my($counter) = new File::CounterFile "$table.$field",0;
+# hack for web demo
+# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
+# my($user)=$1;
+# my($counter) = new File::CounterFile "$user/$table.$field",0;
+# endhack
+
+ my($index)=$counter->inc;
+ $index=$counter->inc
+ while qsearchs($table,{$field=>$index}); #just in case
+ &swapuid;
+
+ $index =~ /^(\d*)$/;
+ $index=$1;
+
+ $self->setfield($field,$index);
+
+}
+
+=item ut_float COLUMN
+
+Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May not be
+null. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_float {
+ my($self,$field)=@_ ;
+ ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
+ $self->getfield($field) =~ /^(\d+)$/ ||
+ $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
+ $self->getfield($field) =~ /^(\d+e\d+)$/)
+ or return "Illegal or empty (float) $field: ". $self->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
+
+Check/untaint phone numbers. May be null. If there is an error, returns
+the error, otherwise returns false.
+
+=cut
+
+sub ut_phonen {
+ my($self,$field)=@_;
+ my $phonen = $self->getfield($field);
+ if ( $phonen eq '' ) {
+ $self->setfield($field,'');
+ } else {
+ $phonen =~ s/\D//g;
+ $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
+ or return "Illegal (phone) $field: ". $self->getfield($field);
+ $phonen = "$1-$2-$3";
+ $phonen .= " x$4" if $4;
+ $self->setfield($field,$phonen);
+ }
+ '';
+}
+
+=item ut_anything COLUMN
+
+Untaints arbitrary data. Be careful.
+
+=cut
+
+sub ut_anything {
+ my($self,$field)=@_;
+ $self->getfield($field) =~ /^(.*)$/
+ or return "Illegal $field: ". $self->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<FS::dbdef_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<FS::dbdef>), optionally from a non-default
+filename. This command is executed at startup unless
+I<$FS::Record::setup_hack> is true. Returns a FS::dbdef object.
+
+=cut
+
+sub reload_dbdef {
+ my $file = shift || $dbdef_file;
+ $dbdef = load FS::dbdef ($file);
+}
+
+=item dbdef
+
+Returns the current database definition. See L<FS::dbdef>.
+
+=cut
+
+sub dbdef { $dbdef; }
+
+=item _quote VALUE, TABLE, COLUMN
+
+This is an internal function used to construct SQL statements. It returns
+VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
+type (see L<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 {
+# 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.2 1999-08-04 10:41:22 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 whith 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)
+
+=head1 SEE ALSO
+
+L<FS::dbdef>, L<FS::UID>, L<DBI>
+
+Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::SSH;
+
+use strict;
+use vars qw(@ISA @EXPORT_OK $ssh $scp);
+use Exporter;
+use IPC::Open2;
+use IPC::Open3;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(ssh scp issh iscp sshopen2 sshopen3);
+
+$ssh="ssh";
+$scp="scp";
+
+=head1 NAME
+
+FS::SSH - Subroutines to call ssh and scp
+
+=head1 SYNOPSIS
+
+ use FS::SSH qw(ssh scp issh iscp sshopen2 sshopen3);
+
+ ssh($host, $command);
+
+ issh($host, $command);
+
+ scp($source, $destination);
+
+ iscp($source, $destination);
+
+ sshopen2($host, $reader, $writer, $command);
+
+ sshopen3($host, $reader, $writer, $error, $command);
+
+=head1 DESCRIPTION
+
+ Simple wrappers around ssh and scp commands.
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item ssh HOST, COMMAND
+
+Calls ssh in batch mode.
+
+=cut
+
+sub ssh {
+ my($host,$command)=@_;
+ my(@cmd)=($ssh, "-o", "BatchMode yes", $host, $command);
+# print join(' ',@cmd),"\n";
+#0;
+ system(@cmd);
+}
+
+=item issh HOST, COMMAND
+
+Prints the ssh command to be executed, waits for the user to confirm, and
+(optionally) executes the command.
+
+=cut
+
+sub issh {
+ my($host,$command)=@_;
+ my(@cmd)=($ssh, $host, $command);
+ print join(' ',@cmd),"\n";
+ if ( &_yesno ) {
+ ###print join(' ',@cmd),"\n";
+ system(@cmd);
+ }
+}
+
+=item scp SOURCE, DESTINATION
+
+Calls scp in batch mode.
+
+=cut
+
+sub scp {
+ my($src,$dest)=@_;
+ my(@cmd)=($scp,"-Bprq",$src,$dest);
+# print join(' ',@cmd),"\n";
+#0;
+ system(@cmd);
+}
+
+=item iscp SOURCE, DESTINATION
+
+Prints the scp command to be executed, waits for the user to confirm, and
+(optionally) executes the command.
+
+=cut
+
+sub iscp {
+ my($src,$dest)=@_;
+ my(@cmd)=($scp,"-pr",$src,$dest);
+ print join(' ',@cmd),"\n";
+ if ( &_yesno ) {
+ ###print join(' ',@cmd),"\n";
+ system(@cmd);
+ }
+}
+
+=item sshopen2 HOST, READER, WRITER, COMMAND
+
+Connects the supplied filehandles to the ssh process (in batch mode).
+
+=cut
+
+sub sshopen2 {
+ my($host,$reader,$writer,$command)=@_;
+ open2($reader,$writer,$ssh,'-o','Batchmode yes',$host,$command);
+}
+
+=item sshopen3 HOST, WRITER, READER, ERROR, COMMAND
+
+Connects the supplied filehandles to the ssh process (in batch mode).
+
+=cut
+
+sub sshopen3 {
+ my($host,$writer,$reader,$error,$command)=@_;
+ open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command);
+}
+
+sub _yesno {
+ print "Proceed [y/N]:";
+ my($x)=scalar(<STDIN>);
+ $x =~ /^y/i;
+}
+
+=head1 BUGS
+
+Not OO.
+
+scp stuff should transparantly use rsync-over-ssh instead.
+
+=head1 SEE ALSO
+
+L<ssh>, L<scp>, L<IPC::Open2>, L<IPC::Open3>
+
+=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
+);
+use subs qw(
+ getsecrets cgisetotaker
+);
+use Exporter;
+use Carp;
+use DBI;
+use FS::Conf;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
+ adminsuidsetup getotaker dbh datasrc getsecrets );
+
+$freeside_uid = scalar(getpwnam('freeside'));
+
+$conf_dir = "/usr/local/etc/freeside/";
+
+=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;
+
+=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 = DBI->connect($datasrc,$db_user,$db_pass, {
+ 'AutoCommit' => 'true',
+ 'ChopBlanks' => 'true',
+ } ) or die "DBI->connect error: $DBI::errstr\n";
+
+ swapuid(); #go to non-privledged user if running setuid freeside
+
+ foreach ( keys %callback ) {
+ &{$callback{$_}};
+ }
+
+ $dbh;
+}
+
+=item cgisuidsetup CGI_object
+
+Stores the CGI (see L<CGI>) object for later use. (CGI::Base is depriciated)
+Runs adminsuidsetup.
+
+=cut
+
+sub cgisuidsetup {
+ $cgi=shift;
+ if ( $cgi->isa('CGI::Base') ) {
+ carp "Use of CGI::Base is depriciated";
+ } elsif ( ! $cgi->isa('CGI') ) {
+ croak "Pass a CGI object to cgisuidsetup!";
+ }
+ cgisetotaker;
+ adminsuidsetup($user);
+}
+
+=item cgi
+
+Returns the CGI (see L<CGI>) object.
+
+=cut
+
+sub cgi {
+ $cgi;
+}
+
+=item dbh
+
+Returns the DBI database handle.
+
+=cut
+
+sub dbh {
+ $dbh;
+}
+
+=item datasrc
+
+Returns the DBI data source.
+
+=cut
+
+sub datasrc {
+ $datasrc;
+}
+
+#hack for web demo
+#sub setdbh {
+# $dbh=$_[0];
+#}
+
+sub suidsetup {
+ croak "suidsetup depriciated";
+}
+
+=item getotaker
+
+Returns the current Freeside user.
+
+=cut
+
+sub getotaker {
+ $user;
+}
+
+=item cgisetotaker
+
+Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
+object. Support for CGI::Base and derived classes is depriciated.
+
+=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 );
+ } else {
+ die "fatal: Can't get REMOTE_USER!";
+ }
+ $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";
+ ($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.1 1999-08-04 09:03:53 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 iff 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.1 1999-08-04 09:03:53 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 $add1 $add2 $add3 $add4 );
+use Date::Format;
+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;
+ ( $add1, $add2, $add3, $add4 ) = ( $conf->config('address'), '', '', '', '' );
+};
+
+=head1 NAME
+
+FS::cust_bill - Object methods for cust_bill records
+
+=head1 SYNOPSIS
+
+ use FS::cust_bill;
+
+ $record = 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. FS::cust_bill inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item invnum - primary key (assigned automatically for new invoices)
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item charged - amount of this invoice
+
+=item owed - amount still outstanding on this invoice, which is charged minus
+all payments (see L<FS::cust_pay>).
+
+=item printed - how many times this invoice has been printed automatically
+(see L<FS::cust_main/"collect">).
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item 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.
+
+When adding new invoices, owed must be charged (or null, in which case it is
+automatically set to charged).
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ $self->owed( $self->charged ) if $self->owed eq '';
+ return "owed != charged!"
+ unless $self->owed == $self->charged;
+
+ $self->SUPER::insert;
+}
+
+=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 owed and printed may be changed. Owed is normally updated by creating and
+inserting a payment (see L<FS::cust_pay>). Printed is normally updated by
+calling the collect method of a customer object (see L<FS::cust_main>).
+
+=cut
+
+sub replace {
+ my( $new, $old ) = ( 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;
+ return "(New) owed can't be > (new) charged!" if $new->owed > $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_money('owed')
+ || $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 print_text [TIME];
+
+Returns an ASCII invoice, as a list of lines.
+
+TIME an optional value used to control the printing of overdue messages. The
+default is now. It isn't the date of the invoice; that's the `_date' field.
+It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub print_text {
+
+ my( $self, $today ) = ( 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;
+
+ #overdue?
+ my $overdue = (
+ $balance_due > 0
+ && $today > $self->_date
+ && $self->printed > 1
+ );
+
+ #printing bits here (yuck!)
+
+ my @collect = ();
+
+ my($description,$amount);
+ my(@buf);
+
+ #format address
+ my($l,@address)=(0,'','','','','','','');
+ $address[$l++] =
+ $cust_main->payname.
+ ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo
+ ? " (P.O. #". $cust_main->payinfo. ")"
+ : ''
+ )
+ ;
+ $address[$l++]=$cust_main->company if $cust_main->company;
+ $address[$l++]=$cust_main->address1;
+ $address[$l++]=$cust_main->address2 if $cust_main->address2;
+ $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ".
+ $cust_main->zip;
+ $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
+
+ #previous balance
+ foreach ( @pr_cust_bill ) {
+ push @buf, (
+ "Previous Balance, Invoice #". $_->invnum.
+ " (". time2str("%x",$_->_date). ")",
+ '$'. sprintf("%10.2f",$_->owed)
+ );
+ }
+ if (@pr_cust_bill) {
+ push @buf,('','-----------');
+ push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
+ push @buf,('','');
+ }
+
+ #new charges
+ foreach ( $self->cust_bill_pkg ) {
+
+ if ( $_->pkgnum ) {
+
+ my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
+ my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
+ my($pkg)=$part_pkg->pkg;
+
+ if ( $_->setup != 0 ) {
+ push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) );
+ push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels;
+ }
+
+ if ( $_->recur != 0 ) {
+ push @buf, (
+ "$pkg (" . time2str("%x",$_->sdate) . " - " .
+ time2str("%x",$_->edate) . ")",
+ '$' . sprintf("%10.2f",$_->recur)
+ );
+ push @buf, map { " ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels;
+ }
+
+ } else { #pkgnum Tax
+ push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
+ if $_->setup != 0;
+ }
+ }
+
+ push @buf,('','-----------');
+ push @buf,('Total New Charges',
+ '$' . sprintf("%10.2f",$self->charged) );
+ push @buf,('','');
+
+ push @buf,('','-----------');
+ push @buf,('Total Charges',
+ '$' . sprintf("%10.2f",$self->charged + $pr_total) );
+ push @buf,('','');
+
+ #credits
+ foreach ( @cr_cust_credit ) {
+ push @buf,(
+ "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
+ '$' . sprintf("%10.2f",$_->credited)
+ );
+ }
+
+ #get & print payments
+ foreach ( $self->cust_pay ) {
+ push @buf,(
+ "Payment received ". time2str("%x",$_->_date ),
+ '$' . sprintf("%10.2f",$_->paid )
+ );
+ }
+
+ #balance due
+ push @buf,('','-----------');
+ push @buf,('Balance Due','$' .
+ sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
+
+ #now print
+
+ my $tot_lines = 50; #should be configurable
+ #header is 17 lines
+ my $tot_pages = int( scalar(@buf) / ( 2 * ( $tot_lines - 17 ) ) );
+ $tot_pages++ if scalar(@buf) % ( 2 * ( $tot_lines - 17 ) );
+
+ my $page = 1;
+ my $lines;
+ while (@buf) {
+ $lines = $tot_lines;
+ my @header = &header(
+ $page, $tot_pages, $self->_date, $self->invnum, @address
+ );
+ push @collect, @header;
+ $lines -= scalar(@header);
+
+ while ( $lines-- && @buf ) {
+ $description=shift(@buf);
+ $amount=shift(@buf);
+ push @collect, myswrite($description, $amount);
+ }
+ $page++;
+ }
+ while ( $lines-- ) {
+ push @collect, myswrite('', '');
+ }
+
+ return @collect;
+
+ sub header { #17 lines
+ my ( $page, $tot_pages, $date, $invnum, @address ) = @_ ;
+ push @address, '', '', '', '';
+
+ my @return = ();
+ my $i = ' 'x32;
+ push @return,
+ '',
+ $i. 'Invoice',
+ $i. substr("Page $page of $tot_pages".' 'x10, 0, 20).
+ time2str("%x", $date ). " FS-". $invnum,
+ '',
+ '',
+ $add1,
+ $add2,
+ $add3,
+ $add4,
+ '',
+ splice @address, 0, 7;
+ ;
+ return map $_. "\n", @return;
+ }
+
+ sub myswrite {
+ my $format = <<END;
+ @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
+END
+ $^A = '';
+ formline( $format, @_ );
+ return $^A;
+ }
+
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_bill.pm,v 1.1 1999-08-04 09:03:53 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>)
+
+=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.1 1999-08-04 09:03:53 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( qsearchs );
+use FS::cust_main;
+
+@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. FS::cust_credit inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item crednum - primary key (assigned automatically for new credits)
+
+=item custnum - customer (see L<FS::cust_main>)
+
+=item amount - amount of the credit
+
+=item credited - how much of this credit that is still outstanding, which is
+amount minus all refunds (see L<FS::cust_refund>).
+
+=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=item otaker - order taker (assigned automatically, see L<FS::UID>)
+
+=item reason - text
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item 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.
+
+When adding new invoices, credited must be amount (or null, in which case it is
+automatically set to amount).
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $error;
+ return $error if $error = $self->ut_money('credited')
+ || $self->ut_money('amount');
+
+ $self->credited($self->amount) if $self->credited == 0
+ || $self->credited eq '';
+ return "credited != amount!"
+ unless $self->credited == $self->amount;
+
+ $self->SUPER::insert;
+}
+
+=item delete
+
+Currently unimplemented.
+
+=cut
+
+sub delete {
+ return "Can't remove credit!"
+}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+Only credited may be changed. Credited is normally updated by creating and
+inserting a refund (see L<FS::cust_refund>).
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( 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 amount!" unless $old->amount == $new->amount;
+ return "(New) credited can't be > (new) amount!"
+ if $new->credited > $new->amount;
+
+ $new->SUPER::replace($old);
+}
+
+=item check
+
+Checks all fields to make sure this is a valid credit. If there is an error,
+returns the error, otherwise returns false. Called by the insert and replace
+methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('crednum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('amount')
+ || $self->ut_money('credited')
+ || $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
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_credit.pm,v 1.1 1999-08-04 09:03:53 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 );
+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.
+
+=cut
+
+sub insert {
+ my $self = shift;
+
+ my $flag = 0;
+ if ( $self->payby eq 'PREPAY' ) {
+ $self->payby('BILL');
+ $flag = 1;
+ }
+
+ 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 $error = $self->SUPER::insert;
+ return $error if $error;
+
+ if ( $flag ) {
+ my $prepay_credit =
+ qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+ warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
+ unless $prepay_credit;
+ my $amount = $prepay_credit->amount;
+ my $error = $prepay_credit->delete;
+ if ( $error ) {
+ warn "WARNING: can't delete prepay_credit: ". $self->payinfo;
+ } else {
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ };
+ my $error = $cust_credit->insert;
+ warn "WARNING: error inserting cust_credit for prepay_credit: $error"
+ if $error;
+ }
+
+ }
+
+ '';
+
+}
+
+=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;
+
+ if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
+ return "Can't delete a customer with invoices";
+ }
+ if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
+ return "Can't delete a customer with credits";
+ }
+
+ 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 @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+ if ( @cust_pkg ) {
+ my $new_custnum = shift;
+ return "Invalid new customer number: $new_custnum"
+ unless qsearchs( 'cust_main', { 'custnum' => $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);
+ return $error if $error;
+ }
+ }
+ foreach my $cust_main_invoice (
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
+ ) {
+ my $error = $cust_main_invoice->delete;
+ return $error if $error;
+ }
+
+ $self->SUPER::delete;
+}
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=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')
+ || $self->ut_phonen('daytime')
+ || $self->ut_phonen('night')
+ || $self->ut_phonen('fax')
+ ;
+ return $error if $error;
+
+ return "Unknown agent"
+ unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
+
+ return "Unknown referral"
+ unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
+
+ $self->getfield('last') =~ /^([\w \,\.\-\']+)$/
+ or return "Illegal last name: ". $self->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,
+ } );
+ }
+
+ $self->zip =~ /^\s*(\w[\w\-\s]{3,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;
+ 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';
+
+ # 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');
+ my $cpt = new Safe;
+ #$cpt->permit(); #what is necessary?
+ $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+ $setup = $cpt->reval($setup_prog);
+ unless ( defined($setup) ) {
+ warn "Error reval-ing part_pkg->setup pkgpart ",
+ $part_pkg->pkgpart, ": $@";
+ } else {
+ $cust_pkg->setfield('setup',$time);
+ $cust_pkg_mod_flag=1;
+ }
+ }
+
+ #bill recurring fee
+ my $recur = 0;
+ my $sdate;
+ if ( $part_pkg->getfield('freq') > 0 &&
+ ! $cust_pkg->getfield('susp') &&
+ ( $cust_pkg->getfield('bill') || 0 ) < $time
+ ) {
+ my $recur_prog = $part_pkg->getfield('recur');
+ my $cpt = new Safe;
+ #$cpt->permit(); #what is necessary?
+ $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
+ $recur = $cpt->reval($recur_prog);
+ unless ( defined($recur) ) {
+ warn "Error reval-ing part_pkg->recur pkgpart ",
+ $part_pkg->pkgpart, ": $@";
+ } else {
+ #change this bit to use Date::Manip?
+ #$sdate=$cust_pkg->bill || time;
+ #$sdate=$cust_pkg->bill || $time;
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($sdate) )[0,1,2,3,4,5];
+ $mon += $part_pkg->getfield('freq');
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+ $cust_pkg->setfield('bill',
+ timelocal($sec,$min,$hour,$mday,$mon,$year));
+ $cust_pkg_mod_flag = 1;
+ }
+ }
+
+ warn "setup is undefinded" unless defined($setup);
+ warn "recur is undefinded" unless defined($recur);
+ warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
+
+ if ( $cust_pkg_mod_flag ) {
+ $error=$cust_pkg->replace($old_cust_pkg);
+ if ( $error ) { #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 );
+
+ return '' if scalar(@cust_bill_pkg) == 0;
+
+ 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;
+ #shouldn't happen, but how else to handle this? (wrap me in eval, to catch
+ # fatal errors)
+ die "Error creating cust_bill record: $error!\n",
+ "Check updated but unbilled packages for customer", $self->custnum, "\n"
+ if $error;
+
+ my $invnum = $cust_bill->invnum;
+ my $cust_bill_pkg;
+ foreach $cust_bill_pkg ( @cust_bill_pkg ) {
+ $cust_bill_pkg->setfield( 'invnum', $invnum );
+ $error = $cust_bill_pkg->insert;
+ #shouldn't happen, but how else tohandle this?
+ die "Error creating cust_bill_pkg record: $error!\n",
+ "Check incomplete invoice ", $invnum, "\n"
+ if $error;
+ }
+
+ ''; #no error
+}
+
+=item collect OPTIONS
+
+(Attempt to) collect money for this customer's outstanding invoices (see
+L<FS::cust_bill>). Usually used after the bill method.
+
+Depending on the value of `payby', this may print an invoice (`BILL'), charge
+a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
+
+If there is an error, returns the error, otherwise returns false.
+
+Currently available options are:
+
+invoice_time - Use this time when deciding when to print invoices and
+late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
+for conversion functions.
+
+batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
+default, cards are processed immediately, which will generate an error if
+CyberCash is not installed.
+
+report_badcard - Set this true if you want bad card transactions to
+return an error. By default, they don't.
+
+=cut
+
+sub collect {
+ my( $self, %options ) = @_;
+ my $invoice_time = $options{'invoice_time'} || time;
+
+ my $total_owed = $self->balance;
+ warn "collect: total owed $total_owed " if $Debug;
+ return '' unless $total_owed > 0; #redundant?????
+
+ #put below somehow?
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ 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;
+ return 'Error COMPing invnum #' . $cust_bill->invnum .
+ ':' . $error if $error;
+
+ } elsif ( $self->payby eq 'CARD' ) {
+
+ if ( $options{'batch_card'} ne 'yes' ) {
+
+ return "Real time card processing not enabled!" unless $processor;
+
+ if ( $processor =~ /^cybercash/ ) {
+
+ #fix exp. date for cybercash
+ #$self->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 {
+ return "Unkonwn real-time processor $processor\n";
+ }
+
+ #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
+ #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
+ if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
+ 'paid' => $amount,
+ '_date' => '',
+ 'payby' => 'CARD',
+ 'payinfo' => $self->payinfo,
+ 'paybatch' => "$processor:$paybatch",
+ } );
+ my $error = $cust_pay->insert;
+ return 'Error applying payment, invnum #' .
+ $cust_bill->invnum. ':'. $error if $error;
+ } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
+ || $options{'report_badcard'} ) {
+ return 'Cybercash error, invnum #' .
+ $cust_bill->invnum. ':'. $result{'MErrMsg'};
+ } else {
+ return '';
+ }
+
+ } else {
+ return "Unkonwn 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;
+ return "Error adding to cust_pay_batch: $error" if $error;
+
+ }
+
+ } else {
+ return "Unknown payment type ". $self->payby;
+ }
+
+ }
+ '';
+
+}
+
+=item total_owed
+
+Returns the total owed for this customer on all invoices
+(see L<FS::cust_bill>).
+
+=cut
+
+sub total_owed {
+ my $self = 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.4 2000-02-02 20:22:18 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 <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)
+
+=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.1 1999-08-04 09:03:53 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. 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;
+
+ $error = $self->check;
+ return $error if $error;
+
+ my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
+ return "Unknown invnum" unless $old_cust_bill;
+ my %hash = $old_cust_bill->hash;
+ $hash{'owed'} = sprintf("%.2f", $hash{owed} - $self->paid );
+ my $new_cust_bill = new FS::cust_bill ( \%hash );
+
+ 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_cust_bill->replace($old_cust_bill);
+ return "Error modifying cust_bill: $error" if $error;
+
+ $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.1 1999-08-04 09:03:53 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 \w\wy";
+ $self->country($1);
+
+ #check invnum, custnum, ?
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pay_batch.pm,v 1.1 1999-08-04 09:03:53 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 );
+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;
+
+@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';
+
+ 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 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;
+ return "Error cancelling service: $error" if $error;
+ $error = $svc->delete;
+ return "Error deleting service: $error" if $error;
+ }
+
+ $error = $cust_svc->delete;
+ return "Error deleting cust_svc: $error" if $error;
+
+ }
+
+ unless ( $self->getfield('cancel') ) {
+ my %hash = $self->hash;
+ $hash{'cancel'} = time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
+ return $error if $error;
+ }
+
+ ''; #no errors
+}
+
+=item suspend
+
+Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
+package, then suspends the package itself (sets the susp field to now).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub suspend {
+ my $self = 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';
+
+ 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 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;
+ return $error if $error;
+ }
+
+ }
+
+ unless ( $self->getfield('susp') ) {
+ my %hash = $self->hash;
+ $hash{'susp'} = time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
+ return $error if $error;
+ }
+
+ ''; #no errors
+}
+
+=item unsuspend
+
+Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
+package, then unsuspends the package itself (clears the susp field).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unsuspend {
+ my $self = 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';
+
+ 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 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;
+ return $error if $error;
+ }
+
+ }
+
+ unless ( ! $self->getfield('susp') ) {
+ my %hash = $self->hash;
+ $hash{'susp'} = '';
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
+ return $error if $error;
+ }
+
+ ''; #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)=@_;
+
+ # 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} ) {
+ return "Customer not permitted to purchase pkgpart $pkgpart!"
+ unless $part_pkg{$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{$_} };
+ 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});
+ die "Package $pkgnum not found to remove!" unless $old;
+ my(%hash) = $old->hash;
+ $hash{'cancel'}=time;
+ my($new) = new FS::cust_pkg ( \%hash );
+ my($error)=$new->replace($old);
+ die "Couldn't update package $pkgnum: $error" if $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;
+ die "Couldn't insert new cust_pkg record: $error" if $error;
+ my($pkgnum)=$new->getfield('pkgnum');
+
+ my($cust_svc);
+ foreach $cust_svc ( @{ shift @cust_svc } ) {
+ my(%hash) = $cust_svc->hash;
+ $hash{'pkgnum'}=$pkgnum;
+ my($new) = new FS::cust_svc ( \%hash );
+ my($error)=$new->replace($cust_svc);
+ die "Couldn't link old service to new package: $error" if $error;
+ }
+ }
+
+ ''; #no errors
+}
+
+=back
+
+=head1 VERSION
+
+$Id: cust_pkg.pm,v 1.3 1999-11-08 21:38:38 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. 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;
+
+ $error=$self->check;
+ return $error if $error;
+
+ my $old_cust_credit =
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
+ return "Unknown crednum" unless $old_cust_credit;
+ my %hash = $old_cust_credit->hash;
+ $hash{credited} = sprintf("%.2f", $hash{credited} - $self->refund );
+ my($new_cust_credit) = new FS::cust_credit ( \%hash );
+
+ 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_cust_credit->replace($old_cust_credit);
+ return "Error modifying cust_credit: $error" if $error;
+
+ $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.1 1999-08-04 09:03:53 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::dbdef;
+
+use strict;
+use vars qw(@ISA);
+use Exporter;
+use Carp;
+use FreezeThaw qw(freeze thaw cmpStr);
+use FS::dbdef_table;
+use FS::dbdef_unique;
+use FS::dbdef_index;
+use FS::dbdef_column;
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef - Database objects
+
+=head1 SYNOPSIS
+
+ use FS::dbdef;
+
+ $dbdef = new FS::dbdef (@dbdef_table_objects);
+ $dbdef = load FS::dbdef "filename";
+
+ $dbdef->save("filename");
+
+ $dbdef->addtable($dbdef_table_object);
+
+ @table_names = $dbdef->tables;
+
+ $FS_dbdef_table_object = $dbdef->table;
+
+=head1 DESCRIPTION
+
+FS::dbdef objects are collections of FS::dbdef_table objects and represnt
+a database (a collection of tables).
+
+=head1 METHODS
+
+=over 4
+
+=item new TABLE, TABLE, ...
+
+Creates a new FS::dbdef object
+
+=cut
+
+sub new {
+ my($proto,@tables)=@_;
+ my(%tables)=map { $_->name, $_ } @tables; #check for duplicates?
+
+ my($class) = ref($proto) || $proto;
+ my($self) = {
+ 'tables' => \%tables,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item load FILENAME
+
+Loads an FS::dbdef object from a file.
+
+=cut
+
+sub load {
+ my($proto,$file)=@_; #use $proto ?
+ open(FILE,"<$file") or die "Can't open $file: $!";
+ my($string)=join('',<FILE>); #can $string have newlines? pry not?
+ close FILE or die "Can't close $file: $!";
+ my($self)=thaw $string;
+ #no bless needed?
+ $self;
+}
+
+=item save FILENAME
+
+Saves an FS::dbdef object to a file.
+
+=cut
+
+sub save {
+ my($self,$file)=@_;
+ my($string)=freeze $self;
+ open(FILE,">$file") or die "Can't open $file: $!";
+ print FILE $string;
+ close FILE or die "Can't close file: $!";
+ my($check_self)=thaw $string;
+ die "Verify error: Can't freeze and thaw dbdef $self"
+ if (cmpStr($self,$check_self));
+}
+
+=item addtable TABLE
+
+Adds this FS::dbdef_table object.
+
+=cut
+
+sub addtable {
+ my($self,$table)=@_;
+ ${$self->{'tables'}}{$table->name}=$table; #check for dupliates?
+}
+
+=item tables
+
+Returns the names of all tables.
+
+=cut
+
+sub tables {
+ my($self)=@_;
+ keys %{$self->{'tables'}};
+}
+
+=item table TABLENAME
+
+Returns the named FS::dbdef_table object.
+
+=cut
+
+sub table {
+ my($self,$table)=@_;
+ $self->{'tables'}->{$table};
+}
+
+=head1 BUGS
+
+Each FS::dbdef object should have a name which corresponds to its name within
+the SQL database engine.
+
+=head1 SEE ALSO
+
+L<FS::dbdef_table>, L<FS::Record>,
+
+=cut
+
+1;
+
--- /dev/null
+package FS::dbdef_colgroup;
+
+use strict;
+use vars qw(@ISA);
+use Exporter;
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef_colgroup - Column group objects
+
+=head1 SYNOPSIS
+
+ use FS::dbdef_colgroup;
+
+ $colgroup = new FS::dbdef_colgroup ( $lol );
+ $colgroup = new FS::dbdef_colgroup (
+ [
+ [ 'single_column' ],
+ [ 'multiple_columns', 'another_column', ],
+ ]
+ );
+
+ @sql_lists = $colgroup->sql_list;
+
+ @singles = $colgroup->singles;
+
+=head1 DESCRIPTION
+
+FS::dbdef_colgroup objects represent sets of sets of columns.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Creates a new FS::dbdef_colgroup object.
+
+=cut
+
+sub new {
+ my($proto, $lol) = @_;
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'lol' => $lol,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item sql_list
+
+Returns a flat list of comma-separated values, for SQL statements.
+
+=cut
+
+sub sql_list { #returns a flat list of comman-separates lists (for sql)
+ my($self)=@_;
+ grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
+}
+
+=item singles
+
+Returns a flat list of all single item lists.
+
+=cut
+
+sub singles { #returns single-field groups as a flat list
+ my($self)=@_;
+ #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+ map {
+ ${$_}[0] =~ /^(\w+)$/
+ #aah!
+ or die "Illegal column ", ${$_}[0], " in colgroup!";
+ $1;
+ } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::dbdef_table>, L<FS::dbdef_unique>, L<FS::dbdef_index>,
+L<FS::dbdef_column>, L<FS::dbdef>, L<perldsc>
+
+=cut
+
+1;
+
--- /dev/null
+package FS::dbdef_column;
+
+use strict;
+#use Carp;
+use Exporter;
+use vars qw(@ISA);
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef_column - Column object
+
+=head1 SYNOPSIS
+
+ use FS::dbdef_column;
+
+ $column_object = new FS::dbdef_column ( $name, $sql_type, '' );
+ $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL' );
+ $column_object = new FS::dbdef_column ( $name, $sql_type, '', $length );
+ $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL', $length );
+
+ $name = $column_object->name;
+ $column_object->name ( 'name' );
+
+ $name = $column_object->type;
+ $column_object->name ( 'sql_type' );
+
+ $name = $column_object->null;
+ $column_object->name ( 'NOT NULL' );
+
+ $name = $column_object->length;
+ $column_object->name ( $length );
+
+ $sql_line = $column->line;
+ $sql_line = $column->line $datasrc;
+
+=head1 DESCRIPTION
+
+FS::dbdef::column objects represend columns in tables (see L<FS::dbdef_table>).
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Creates a new FS::dbdef_column object.
+
+=cut
+
+sub new {
+ my($proto,$name,$type,$null,$length)=@_;
+
+ #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+
+ $null =~ s/^NOT NULL$//i;
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'name' => $name,
+ 'type' => $type,
+ 'null' => $null,
+ 'length' => $length,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item name
+
+Returns or sets the column name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+ $self->{'name'} = $value;
+ } else {
+ $self->{'name'};
+ }
+}
+
+=item type
+
+Returns or sets the column type.
+
+=cut
+
+sub type {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'type'} = $value;
+ } else {
+ $self->{'type'};
+ }
+}
+
+=item null
+
+Returns or sets the column null flag.
+
+=cut
+
+sub null {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $value =~ s/^NOT NULL$//i;
+ $self->{'null'} = $value;
+ } else {
+ $self->{'null'};
+ }
+}
+
+=item type
+
+Returns or sets the column length.
+
+=cut
+
+sub length {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'length'} = $value;
+ } else {
+ $self->{'length'};
+ }
+}
+
+=item line [ $datasrc ]
+
+Returns an SQL column definition.
+
+If passed a DBI $datasrc specifying L<DBD::mysql> or L<DBD::Pg>, will use
+engine-specific syntax.
+
+=cut
+
+sub line {
+ my($self,$datasrc)=@_;
+ my($null)=$self->null;
+ if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
+ $null ||= "NOT NULL"
+ }
+ if ( $datasrc =~ /Pg/ ) { #yucky Pg hack
+ $null ||= "NOT NULL";
+ $null =~ s/^NULL$//;
+ }
+ join(' ',
+ $self->name,
+ $self->type. ( $self->length ? '('.$self->length.')' : '' ),
+ $null,
+ );
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::dbdef_table>, L<FS::dbdef>, L<DBI>
+
+=head1 VERSION
+
+$Id: dbdef_column.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=cut
+
+1;
+
--- /dev/null
+package FS::dbdef_index;
+
+use strict;
+use vars qw(@ISA);
+use FS::dbdef_colgroup;
+
+@ISA=qw(FS::dbdef_colgroup);
+
+=head1 NAME
+
+FS::dbdef_unique.pm - Index object
+
+=head1 SYNOPSIS
+
+ use FS::dbdef_index;
+
+ # see FS::dbdef_colgroup methods
+
+=head1 DESCRIPTION
+
+FS::dbdef_unique objects represent the (non-unique) indices of a table
+(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
+
+=head1 BUGS
+
+Is this empty subclass needed?
+
+=head1 SEE ALSO
+
+L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record>
+
+=cut
+
+1;
+
--- /dev/null
+package FS::dbdef_table;
+
+use strict;
+#use Carp;
+use Exporter;
+use vars qw(@ISA);
+use FS::dbdef_column;
+
+@ISA = qw(Exporter);
+
+=head1 NAME
+
+FS::dbdef_table - Table objects
+
+=head1 SYNOPSIS
+
+ use FS::dbdef_table;
+
+ $dbdef_table = new FS::dbdef_table (
+ "table_name",
+ "primary_key",
+ $FS_dbdef_unique_object,
+ $FS_dbdef_index_object,
+ @FS_dbdef_column_objects,
+ );
+
+ $dbdef_table->addcolumn ( $FS_dbdef_column_object );
+
+ $table_name = $dbdef_table->name;
+ $dbdef_table->name ("table_name");
+
+ $table_name = $dbdef_table->primary_keye;
+ $dbdef_table->primary_key ("primary_key");
+
+ $FS_dbdef_unique_object = $dbdef_table->unique;
+ $dbdef_table->unique ( $FS_dbdef_unique_object );
+
+ $FS_dbdef_index_object = $dbdef_table->index;
+ $dbdef_table->index ( $FS_dbdef_index_object );
+
+ @column_names = $dbdef->columns;
+
+ $FS_dbdef_column_object = $dbdef->column;
+
+ @sql_statements = $dbdef->sql_create_table;
+ @sql_statements = $dbdef->sql_create_table $datasrc;
+
+=head1 DESCRIPTION
+
+FS::dbdef_table objects represent a single database table.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Creates a new FS::dbdef_table object.
+
+=cut
+
+sub new {
+ my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
+
+ my(%columns) = map { $_->name, $_ } @columns;
+
+ #check $primary_key, $unique and $index to make sure they are $columns ?
+ # (and sanity check?)
+
+ my $class = ref($proto) || $proto;
+ my $self = {
+ 'name' => $name,
+ 'primary_key' => $primary_key,
+ 'unique' => $unique,
+ 'index' => $index,
+ 'columns' => \%columns,
+ };
+
+ bless ($self, $class);
+
+}
+
+=item addcolumn
+
+Adds this FS::dbdef_column object.
+
+=cut
+
+sub addcolumn {
+ my($self,$column)=@_;
+ ${$self->{'columns'}}{$column->name}=$column; #sanity check?
+}
+
+=item name
+
+Returns or sets the table name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{name} = $value;
+ } else {
+ $self->{name};
+ }
+}
+
+=item primary_key
+
+Returns or sets the primary key.
+
+=cut
+
+sub primary_key {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{primary_key} = $value;
+ } else {
+ #$self->{primary_key};
+ #hmm. maybe should untaint the entire structure when it comes off disk
+ # cause if you don't trust that, ?
+ $self->{primary_key} =~ /^(\w*)$/
+ #aah!
+ or die "Illegal primary key ", $self->{primary_key}, " in dbdef!\n";
+ $1;
+ }
+}
+
+=item unique
+
+Returns or sets the FS::dbdef_unique object.
+
+=cut
+
+sub unique {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{unique} = $value;
+ } else {
+ $self->{unique};
+ }
+}
+
+=item index
+
+Returns or sets the FS::dbdef_index object.
+
+=cut
+
+sub index {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'index'} = $value;
+ } else {
+ $self->{'index'};
+ }
+}
+
+=item columns
+
+Returns a list consisting of the names of all columns.
+
+=cut
+
+sub columns {
+ my($self)=@_;
+ keys %{$self->{'columns'}};
+}
+
+=item column "column"
+
+Returns the column object (see L<FS::dbdef_column>) for "column".
+
+=cut
+
+sub column {
+ my($self,$column)=@_;
+ $self->{'columns'}->{$column};
+}
+
+=item sql_create_table [ $datasrc ]
+
+Returns an array of SQL statments to create this table.
+
+If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
+syntax. Non-standard syntax for other engines (if applicable) may also be
+supported in the future.
+
+=cut
+
+sub sql_create_table {
+ my($self,$datasrc)=@_;
+
+ my(@columns)=map { $self->column($_)->line($datasrc) } $self->columns;
+ push @columns, "PRIMARY KEY (". $self->primary_key. ")"
+ if $self->primary_key;
+ if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
+ push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
+ push @columns, map "INDEX ($_)", $self->index->sql_list;
+ }
+
+ "CREATE TABLE ". $self->name. " ( ". join(", ", @columns). " )",
+ ( map {
+ my($index) = $self->name. "__". $_ . "_index";
+ $index =~ s/,\s*/_/g;
+ "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)"
+ } $self->unique->sql_list ),
+ ( map {
+ my($index) = $self->name. "__". $_ . "_index";
+ $index =~ s/,\s*/_/g;
+ "CREATE INDEX $index ON ". $self->name. " ($_)"
+ } $self->index->sql_list ),
+ ;
+
+
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::dbdef>, L<FS::dbdef_unique>, L<FS::dbdef_index>, L<FS::dbdef_unique>,
+L<DBI>
+
+=head1 VERSION
+
+$Id: dbdef_table.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+
+=cut
+
+1;
+
--- /dev/null
+package FS::dbdef_unique;
+
+use strict;
+use vars qw(@ISA);
+use FS::dbdef_colgroup;
+
+@ISA=qw(FS::dbdef_colgroup);
+
+=head1 NAME
+
+FS::dbdef_unique.pm - Unique object
+
+=head1 SYNOPSIS
+
+ use FS::dbdef_unique;
+
+ # see FS::dbdef_colgroup methods
+
+=head1 DESCRIPTION
+
+FS::dbdef_unique objects represent the unique indices of a database table
+(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
+
+=head1 BUGS
+
+Is this empty subclass needed?
+
+=head1 SEE ALSO
+
+L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record>
+
+=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::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::svc_Common;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearchs fields );
+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';
+
+ $error = $self->check;
+ return $error if $error;
+
+ my $svcnum = $self->svcnum;
+ my $cust_svc;
+ unless ( $svcnum ) {
+ $cust_svc = new FS::cust_svc ( {
+ 'svcnum' => $svcnum,
+ 'pkgnum' => $self->pkgnum,
+ 'svcpart' => $self->svcpart,
+ } );
+ $error = $cust_svc->insert;
+ return $error if $error;
+ $svcnum = $self->svcnum($cust_svc->svcnum);
+ }
+
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $cust_svc->delete if $cust_svc;
+ return $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.
+
+=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.1 1999-08-04 09:03:53 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
+ $shellmachine @saltset @pw_set);
+use FS::Conf;
+use FS::Record qw( qsearchs fields );
+use FS::svc_Common;
+use FS::SSH qw(ssh);
+use FS::part_svc;
+use FS::svc_acct_pop;
+
+@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;
+};
+
+@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;
+
+=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
+
+ useradd -d $dir -m -s $shell -u $uid $username
+
+is executed on shellmachine via ssh. This behaviour can be surpressed by
+setting $FS::svc_acct::nossh_hack true.
+
+=cut
+
+sub insert {
+ my $self = 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 "Unkonwn svcpart" unless $part_svc;
+ return "uid in use"
+ if $part_svc->svc_acct__uid_flag ne 'F'
+ && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
+ && $self->username !~ /^(hyla)?fax$/
+ ;
+
+ $error = $self->SUPER::insert;
+ return $error if $error;
+
+ my ( $username, $uid, $dir, $shell ) = (
+ $self->username,
+ $self->uid,
+ $self->dir,
+ $self->shell,
+ );
+ if ( $username
+ && $uid
+ && $dir
+ && $shellmachine
+ && ! $nossh_hack ) {
+ #one way
+ ssh("root\@$shellmachine",
+ "useradd -d $dir -m -s $shell -u $uid $username"
+ );
+ #another way
+ #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ".
+ # "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ".
+ # "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ".
+ # "/bin/chown -R $uid $dir") unless $nossh_hack;
+ }
+
+ ''; #no error
+}
+
+=item delete
+
+Deletes this account from the database. If there is an error, returns the
+error, otherwise returns false.
+
+The corresponding FS::cust_svc record will be deleted as well.
+
+If the configuration value (see L<FS::Conf>) shellmachine exists, the command:
+
+ userdel $username
+
+is executed on shellmachine via ssh. This behaviour can be surpressed by
+setting $FS::svc_acct::nossh_hack true.
+
+=cut
+
+sub delete {
+ my $self = 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->SUPER::delete;
+ return $error if $error;
+
+ my $username = $self->username;
+ if ( $username && $shellmachine && ! $nossh_hack ) {
+ ssh("root\@$shellmachine","userdel $username");
+ }
+
+ '';
+}
+
+=item replace OLD_RECORD
+
+Replaces OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+If the configuration value (see L<FS::Conf>) shellmachine exists, and the
+dir field has changed, the command:
+
+ [ -d $old_dir ] && (
+ chmod u+t $old_dir;
+ umask 022;
+ mkdir $new_dir;
+ cd $old_dir;
+ find . -depth -print | cpio -pdm $new_dir;
+ chmod u-t $new_dir;
+ chown -R $uid.$gid $new_dir;
+ rm -rf $old_dir
+ )
+
+is executed on shellmachine via ssh. This behaviour can be surpressed by
+setting $FS::svc_acct::nossh_hack true.
+
+=cut
+
+sub replace {
+ my ( $new, $old ) = ( 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 ) = ( $old->getfield('dir'), $new->getfield('dir') );
+ my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') );
+ if ( $old_dir
+ && $new_dir
+ && $old_dir ne $new_dir
+ && ! $nossh_hack
+ ) {
+ ssh("root\@$shellmachine","[ -d $old_dir ] && ".
+ "( chmod u+t $old_dir; ". #turn off qmail delivery
+ "umask 022; mkdir $new_dir; cd $old_dir; ".
+ "find . -depth -print | cpio -pdm $new_dir; ".
+ "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ".
+ "rm -rf $old_dir".
+ ")"
+ );
+ }
+
+ ''; #no error
+}
+
+=item suspend
+
+Suspends this account by prefixing *SUSPENDED* to the password. If there is an
+error, returns the error, otherwise returns false.
+
+Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
+
+=cut
+
+sub suspend {
+ my $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;
+ $recref->{username} =~ /[a-z]/ or return "Illegal username";
+
+ $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum";
+ $recref->{popnum} = $1;
+ return "Unkonwn popnum" unless
+ ! $recref->{popnum} ||
+ qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
+
+ unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
+
+ $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
+ $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
+
+ $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
+ $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
+ #not all systems use gid=uid
+ #you can set a fixed gid in part_svc
+
+ return "Only root can have uid 0"
+ if $recref->{uid} == 0 && $recref->{username} ne 'root';
+
+ my($error);
+ return $error if $error=$self->ut_textn('finger');
+
+ $recref->{dir} =~ /^([\/\w\-]*)$/
+ or return "Illegal directory";
+ $recref->{dir} = $1 ||
+ $dir_prefix . '/' . $recref->{username}
+ #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
+ ;
+
+ unless ( $recref->{username} eq 'sync' ) {
+ my($shell);
+ if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) {
+ $recref->{shell} = $shell;
+ } else {
+ return "Illegal shell \`". $self->shell. "\'; ".
+ $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,24})$/ ) {
+ $recref->{_password} = $1.$3;
+ } elsif ( $recref->{_password} eq '*' ) {
+ $recref->{_password} = '*';
+ } else {
+ return "Illegal password";
+ }
+
+ ''; #no error
+}
+
+=back
+
+=head1 VERSION
+
+$Id: svc_acct.pm,v 1.2 1999-08-12 00:05:03 ivan Exp $
+
+=head1 BUGS
+
+The remote commands should be configurable.
+
+The bits which ssh should fork before doing so.
+
+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<FS::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 FS::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 } );
+
+ $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.1 1999-08-04 09:03:53 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<FS::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
+);
+use Carp;
+use Mail::Internet;
+use Mail::Header;
+use Date::Format;
+use Net::Whois 1.0;
+use FS::Record qw(fields qsearch qsearchs);
+use FS::Conf;
+use FS::svc_Common;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::cust_pkg;
+use FS::cust_main;
+
+@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");
+
+};
+
+=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.
+
+=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 in use (here)"
+ if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
+
+ my $whois = $self->whois;
+ return "Domain in use (see whois)"
+ if ( $self->action eq "N" && $whois );
+ return "Domain not found (see whois)"
+ if ( $self->action eq "M" && ! $whois );
+
+ $error = $self->SUPER::insert;
+ return $error if $error;
+
+ $self->submit_internic unless $whois_hack;
+
+ ''; #no error
+}
+
+=item delete
+
+Deletes this domain from the database. If there is an error, returns the
+error, otherwise returns false.
+
+The corresponding FS::cust_svc record will be deleted as well.
+
+=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.4 2000-01-29 21:10:13 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<FS::SSH>, 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::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/Bill.pm
+FS/CGI.pm
+FS/Conf.pm
+FS/Invoice.pm
+FS/Record.pm
+FS/SSH.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/dbdef.pm
+FS/dbdef_colgroup.pm
+FS/dbdef_column.pm
+FS/dbdef_index.pm
+FS/dbdef_table.pm
+FS/dbdef_unique.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
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+test.pl
+README
+bin/freeside-bill
--- /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[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n 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: Pretent 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.3 1999-10-04 08:23:26 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=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):
+
-Freeside, (pre) 1.1.4
+Freeside, (pre-1.3.0)
-Copyright (C) 1998 Silicon Interactive Software Design. All rights reserved.
+Copyright (C) 2000 Ivan Kohler
+Copyright (C) 1999 Silicon Interactive Software Design
+All rights reserved
This program is free software; you can redistribute it and/or modify
it under the terms of either:
The documentation is in `htdocs/docs'.
A mailing list for users and developers is available. Send a blank message to
-<ivan-freeside-subscribe@sisd.com> to subscribe.
+<ivan-freeside-subscribe@420.am> to subscribe.
-Commercial support is available from Ivan Kohler <ivan@sisd.com>. Please
-subscribe to the the mailing list to request free support!
+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
+mailing list to request free support!
-Ivan Kohler
-ivan@sisd.com
+Ivan Kohler <ivan@420.am>
+$Id: TODO,v 1.41 2000-01-30 06:11:09 ivan Exp $
+
If you are interested in helping with any of these, please join the mailing
list (send a blank message to ivan-freeside-subscribe@sisd.com) to avoid
duplication of effort.
--- 1.1.x --
+---
+
+
+ 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/msg00546.html>, and
+<http://www.sisd.com/freeside/list-archive/msg00554.html>
+
+and http://www.sisd.com/freeside/list-archive/msg00423.html
+
+> > 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 (uses the return value from $sth->execute as
+a number of rows). Fixing this is on the TODO.
+
+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?
-postgres can't deal with NULL!
+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.
-svc_acct.import should recognize "UNIX" in the RADIUS password file as null.
+javascript (yuck!) "are you sure?" confirmation on cancelations, etc.
+(view/cust_pkg and view/svc_*)
-radius logfile parsing and perl expression check.
+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)
-mailing list archive, faq, cvs
+uncomment expire in view/cust_pkg.cgi and find the expire cron from fsold
-(test cust_main.pm with cybercash v2 and v3)
+(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?)
-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).
+Lay out any remaining ugly forms better.
-FIX It doesn't properly inherit/override FS::Record yet, so no more replace vs
-rep silliness!
+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.
-fields should be a method against a FS::Record or derived object, as well as
-being something you can call as FS::Record::fields('tablename'). Might
-even be able to handle both in the same routine (that would be neato).
-Get rid of hfields and other assorted silliness.
-Clean up hfields/sfields/fields crap. yuck.
+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!
-$lpr in cust_main.pm (from Bill.pm) should become /var/spool/freeside/conf/lpr
+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
-Override FS::Record new, add, rep and del (create, insert, replace and
-delete) in all derived classes.
-IE create, insert, delete and replace from derived classes should override new,
-add, del and rep (respectively) from FS::Record. Depriciate old names.
+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.
-Add the ability for services to filter information up to the package level
-for invoices and web screens, so you can select a particlar package based
-on username or domain name, etc.
+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.
+
+Portability: in FS::Record, $sth->execute does not return a number of rows for all DBD's. see man DBI
+
+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).
move all phone number logic out of Freeside - let HylaFAX or whatever
handle it.
-soundex searches for customer name and company? where are free soundex tools? (standard Text::Soundex duh)
-
-should be able to link on (username, domain name, some field in email alias) instead of svcnum only. (username done, what else?)
+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?!
-(done but clean up) change svc_domain.pm mail sending from a pipe to "/usr/lib/sendmail" to Mail::Mailer or Net::SMTP or something. also is the complete text of the registration agreement needed in there (it used to be)?
+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::Bill::collect (past due)
+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.
...
Allow for a future setup date on accounts.
-one-time/per-customer/? changes in rates and descriptions ('remembered
-invoices'): implement by creating a new package on the fly... but it isn't
-associated with any agent types so it won't show up for other customers to buy.
-
-if CGI::Base will not have redirect fixed (cgifix.html), should migrate to
-CGI.pm insetead? It is >1 year newer.
-
-library repetitve stuff from Bill.pm Invoice.pm and friends (calculating
-previous balances etc etc)
-
-
sub AUTOLOAD in FS::Record should warn? die? if used with a non-existant column
name?
edit (not just import, export and allow default/fixed) arbitrary radius stuff
in svc_acct
-
edit/svc_acct.cgi and edit/process/svc_acct.cgi should deal with arbitrary radius stuff
radius import should take DEFAULT entry and put it in /var/spool/freeside/conf/radius-default ; svc_acct.export should use it (and doc)
-FS::Invoice and FS::Bill should merge with the classes they're derived from
-
in UI, s/State/State\/Provence/go and s/County/County\/Locality/go
-.us domains and others!
-
-what else (besides l10n) for i18n?
+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)
Decide based on whether or not the "error" should show up in logs.
all .cgi's should use standard header/footer and idiot() subroutines. maybe HTML:: perl modules
-for HTML creation. CGI.pm instead.
-
-library the conf reading stuff; bin/svc_acct.export version with missing-filename checking is good
-library conf stuff -> check all the conf stuff to make sure they close filehandles.
+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.
store the other information? Maybe you could ask any FS::Record object for a
tied hash?
-change all htdocs/edit/process/* loops to look like: (library this sort of thing!!!!)
-
-my($new) = create FS::svc_acct_sm ( {
- map {
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
-} );
-
-to avoid form errors causing too much silliness
-
-add this code to all svc_*.pm (already in acct and acct_sm and domain): (library!)
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
change all file access from regular open(FILE,) stuff to OO, because of
problems scoping and passing filehandles like that.
-svc_domain.pm mail sending uses Date::Format which doesn't seem to pick up
-correct timezone.
-
-view/svc_domain.cgi needs to know the domain might be unaudited (cosmetic)
-
-Check everything into CVS.
-
---- 1.1.x or 1.2 or later
-
the web interface should create a new object and use it instead of a blank
form for new records. the create method of svc_ objects should set defaults
(from part_svc).
Auto-increment expired cards one year, and try again?
-Lay out the forms a bit better.
-
More non-US stuff - zip codes, country codes, foreign currencies, etc.
cust_refund.{cgi.pm} need to do cards xaxtions. (now we only have cust_credit)
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.
people use/
More CC processors/methods.
-In FS::Record, the counter dir should have .datasrc appended to it like the
-dbdef does, which should place all the (most of) the DB metadata in unique
-files and let me run concurrent .datasrc's. Maybe do something similar for
-user, password and datasrc itself? (or something to get the out of the source
-files) and then we're set. (secrets file also needs .datasrc appended, or maybe
-"/var/spool/freeside".datasrc
-
you should be able to fiddle the setup date in cust_pkg. (at least initially)
-cych v3 and v2 support
-
delete options in administration section
write a generic batch senders and batch parsers.
-need a way to override svc_acct export on a per-machine basis; just use config files based on machine name i suppose; document that.
+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.
-make fs-setup option to add sample data so you can click on "New Customer" right away? so people understand what this stuff is?
-
package view needs to list extraneous services; we need to prevent the
creation of them so this never happens (and mark it as such in the source)
(the creation problem should be fixed - though they will still happen if people
export a debian-style (also redhat and?) /etc/group file aswell!
-seems to be an off-by-one error in the ascii invoice formatting which is saying
-"1 of 2" pages when there is only one.
-
-get rid of agrep? needs the (non-free) glimpse distribution. agrep used to
-be free? what else can do fuzzy searching?
-
-site_perl/svc_domain.cgi (hmm... or maybe should have a button? or maybe svc_domain.pm should handle this) should set $whois_hack for non-internic domains, so you can add them...
-
svc_acct_sm.import qmail import should pull in recipientmap people too.
.pm's like svc_acct.pm which need to do time-consuming things like ssh remotely
Put the GPL notice in all files.
--- 1.2 or later --
+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')
edit/process/svc_wo.cgi
Call tracking and trouble tickets.
-use mod_perl and Apache::AuthDBI instead of mod_auth_mysql when we do local
-users
More accoutability for complimentary accounts: approval, expiration, term
(no more than x months in advance) and notification.
Flag particular users (or all users, for that matter) as having their
employees they can't trust. Right now you're "stuck" with setting up
.htaccess stuff yourself. This should really just be integrated.
-update site_perl/table_template* (pry out of date)
-
-/var/spool/freeside/conf (and whatever else /var/spool/freeside we can)
-in database (except secrets), then web interface,
-make /var/spool/freeside a configurable directory (probably as part of
-some automated installation process?)
-
-add a table with column of export services (passwd, shadow, master.passwd, .qmail file update, dns update, etc.) and rows machine groups and whether or not to export that (and any necessary parameters). wasn't matt (vunderkid, not matt@michweb) working on this? find him? each machine goes in a group of its own as well as a group based on function. add a table with only svcpart and machine group. now, when you import from each machine, it can get its own accounts with one svcpart and universal accounts with another svcpart. (though that does make the username duplicate checking more interesting)
-
-password and slipip stuff in svc_acct.pm store need to be split into two fields or something, so the silliness in svc_acct.pm and svc_acct.export with looking at the data to decide what to do with it can be fixed (1.2)
+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,
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
--- /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/local/bin/perl -Tw
-#
-# bill: Bill customer(s)
-#
-# Usage: bill [ -c [ i ] ] [ -d 'date' ] [ -b ]
-#
-# Bills all customers.
-#
-# Adds record to /dbin/cust_bill and /dbin/cust_pay (if payment made -
-# CARD & COMP), prints invoice / charges card etc.
-#
-# -c: Turn on collecting (you probably want this).
-#
-# -i: real-time billing (as opposed to batch billing). only relevant
-# for credit cards.
-#
-# -d: Pretent it's 'date'. Date is in any format Date::Parse is happy with,
-# but be careful.
-#
-# ## n/a ## -b: send batch when done billing
-#
-# ivan@voicenet.com sep/oct 96
-#
-# separated billing and collections, cleaned up code.
-# ivan@voicenet.com 96-nov-11
-#
-# added -d option
-# ivan@voicenet.com 96-nov-13
-#
-# added -v option and started to implement it, added 'd:' to getopts call
-# (oops!)
-# ivan@voicenet.com 97-jan-2
-#
-# added more debug messages, moved some searches to fssearch.pl library (for
-# speed)
-# rewrote "all customer" finder to know about bill dates, for speed.
-# ivan@voicenet.com 97-jan-8
-#
-# thought about it a while, and removed passing of the -d option to collect...?
-# ivan@voicenet.com 97-jan-14
-#
-# make all -v stuff STDERR
-# ivan@voicenet.com 97-feb-4
-#
-# added pkgnum as argument to program from /db/part_pkg, with kludge for the
-# "/bin/echo XX" 's already there.
-# ivan@voicenet.com 97-feb-23
-#
-# - general cleanup
-# - customers who are suspended can still be billed for the setup fee
-# - cust_pkg record is re-read after the package setup fee program is run.
-# this way,
-# that program can modify the record (for example, to start accounts off
-# suspended)
-# (best to think four or five times before modifying anything else!)
-# ivan@voicenet.com 97-feb-26
-#
-# don't bill recurring fee if its not time! (was removed)
-# ivan@voicenet.com 97-mar-6
-#
-# added -b option, send batch when done billing.
-# ivan@voicenet.com 97-apr-4
-#
-#insecure dependency on line 179ish below needs to be fixed before bill is
-#used setuid
-# ivan@voicenet.com 97-jun-2
-#
-# removed running of setup program (depriciated)
-# ivan@voicenet.com 97-jul-21
-#
-# rewrote for new API, removed option to specify custnums (use FS::Bill
-# instead), removed -v option (?)
-# ivan@voicenet.com 97-jul-22 - 23 - 25 -28
-# (need to add back in email stuff, look in /home/ivan/old/dbin/collect)
-#
-# s/suidsetup/adminsuidsetup/, s/FS::Search/FS::Record/, added some batch
-# exporting stuff (which still needs to be generalized) and removed &idiot
-# ivan@sisd.com 98-may-27
-
-# setup
-
-use strict;
-use Fcntl qw(:flock);
-use Date::Parse;
-use Getopt::Std;
-use FS::UID qw(adminsuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::Bill;
-
-my($batchfile)="/var/spool/freeside/batch";
-my($batchlock)="/var/spool/freeside/batch.lock";
-
-adminsuidsetup;
-
-&untaint_argv; #what it sounds like (eww)
-use vars qw($opt_b $opt_c $opt_i $opt_d);
-getopts("bcid:"); #switches
-
-#we're at now now (and later).
-my($time)= $main::opt_d ? str2time($main::opt_d) : $^T;
-
-# find packages w/ bill < time && cancel != '', and create corresponding
-# customer objects
-
-my($cust_main,%saw);
-foreach $cust_main (
- map {
- if ( ( $_->getfield('bill') || 0 ) <= $time &&
- !$saw{ $_->getfield('custnum') }++ ) {
- qsearchs('cust_main',{'custnum'=> $_->getfield('custnum') } );
- } else {
- ();
- }
- } qsearch('cust_pkg',{'cancel'=>''})
-) {
-
- # and bill them
-
- print "Billing customer #" . $cust_main->getfield('custnum') . "\n";
-
- bless($cust_main,"FS::Bill");
-
- my($error);
-
- $error=$cust_main->bill('time'=>$time);
- warn "Error billing, customer #" . $cust_main->getfield('custnum') .
- ":" . $error if $error;
-
- if ($main::opt_c) {
- $error=$cust_main->collect('invoice_time'=>$time,
- 'batch_card' => $main::opt_i ? 'no' : 'yes',
- );
- warn "Error collecting customer #" . $cust_main->getfield('custnum') .
- ":" . $error if $error;
-
- #sleep 1;
-
- }
-
-}
-
-#if ($main::opt_b) {
-#
-# die "Batch still waiting for reply? ($batchlock exists)\n" if -e $batchlock;
-# open(BATCHLOCK,"+>>$batchlock") or die "Can't open $batchlock: $!";
-# select(BATCHLOCK); $|=1; select(STDOUT);
-# unless ( flock(BATCHLOCK,,LOCK_EX|LOCK_NB) ) {
-# seek(BATCHLOCK,0,0);
-# my($pid)=<BATCHLOCK>;
-# chop($pid);
-# die "Is a batch running? (pid $pid)\n";
-# }
-# seek(BATCHLOCK,0,0);
-# print BATCHLOCK $$,"\n";
-#
-# ( open(BATCH,">$batchfile")
-# and flock(BATCH,LOCK_EX|LOCK_NB)
-# ) or die "Can't open $batchfile: $!";
-#
-# my($cust_pay_batch);
-# foreach $cust_pay_batch (qsearch('cust_pay_batch',{})) {
-# print BATCH join(':',
-# $_->getfield('cardnum'),
-# $_->getfield('exp'),
-# $_->getfield('amount'),
-# $_->getfield('payname')
-# || $_->getfield('first'). ' '. $_->getfield('last'),
-# "Description",
-# $_->getfield('zip'),
-# ),"\n";
-# }
-#
-# flock(BATCH,LOCK_UN);
-# close BATCH;
-#
-# flock(BATCHLOCK,LOCK_UN);
-# close BATCHLOCK;
-#}
-
-# subroutines
-
-sub untaint_argv {
- foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
- $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
- $ARGV[$_]=$1;
- }
-}
-
#!/usr/bin/perl -Tw
#
+# $Id: dbdef-create,v 1.2 1998-11-19 11:17:44 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.2 1998-11-19 11:17:44 ivan
+# adminsuidsetup requires argument
+#
use strict;
use DBI;
use FS::dbdef;
use FS::UID qw(adminsuidsetup datasrc);
-#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
+my $user = shift or die &usage;
-my($dbh)=adminsuidsetup;
+my($dbh)=adminsuidsetup $user;
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
my($tables_sth)=$dbh->prepare("SHOW TABLES");
my($tables_rv)=$tables_sth->execute;
#important
$dbdef->save($dbdef_file);
+sub usage {
+ die "Usage:\n dbdef-create user\n";
+}
#!/usr/bin/perl -Tw
#
-# create database and necessary tables, etc. DBI version.
+# $Id: fs-setup,v 1.22 2000-01-31 05:22:23 ivan Exp $
#
# ivan@sisd.com 97-nov-8,9
#
# ivan@sisd.com 98-sep-4
#
# fix radius attributes ivan@sisd.com 98-sep-27
+#
+# $Log: fs-setup,v $
+# 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 FS::dbdef;
-use FS::UID qw(adminsuidsetup datasrc);
+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) = "/var/spool/freeside/dbdef.". datasrc;
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
###
#my(@date_type) = ( 'timestamp', '', '' );
my(@date_type) = ( 'int', 'NULL', '' );
-my(@perl_type) = ( 'long varchar', 'NULL', '' );
-my(@money_type);
-if (datasrc =~ m/Pg/) { #Pg can't do decimal(10,2)
- @money_type = ( 'money', '', '' );
-} else {
- @money_type = ( 'decimal', '', '10,2' );
-}
+my(@perl_type) = ( 'varchar', 'NULL', 255 );
+my @money_type = ( 'decimal', '', '10,2' );
###
# create a dbdef object from the old data structure
#important
$dbdef->save($dbdef_file);
-FS::Record::reload_dbdef;
+&FS::Record::reload_dbdef($dbdef_file);
###
# create 'em
###
-my($dbh)=adminsuidsetup;
+my($dbh)=adminsuidsetup $user;
#create tables
$|=1;
#not really sample data (and shouldn't default to US)
#cust_main_county
+
+#USPS state codes
foreach ( qw(
AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
-SC SD TN TX TT UT VT VI VA WA WV WI WY AE AA AP
+SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP
) ) {
- my($cust_main_county)=create FS::cust_main_county({
+ my($cust_main_county)=new FS::cust_main_county({
'state' => $_,
'tax' => 0,
+ 'country' => 'US',
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson)
+foreach ( qw(
+VIC NSW NT QLD TAS ACT WA SA
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'state' => $_,
+ 'tax' => 0,
+ 'country' => 'AU',
+ });
+ my($error);
+ $error=$cust_main_county->insert;
+ die $error if $error;
+}
+
+#ISO 2-letter country codes (same as country TLDs) except US and AU
+foreach ( qw(
+AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO
+BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI
+HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA
+GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL
+IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV
+ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG
+NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM
+ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ
+TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH
+YE YU ZR ZM ZW
+) ) {
+ my($cust_main_county)=new FS::cust_main_county({
+ 'tax' => 0,
+ 'country' => $_,
});
my($error);
$error=$cust_main_county->insert;
$dbh->disconnect or die $dbh->errstr;
+sub usage {
+ die "Usage:\n fs-setup user\n";
+}
+
###
# Now it becomes an object. much better.
###
'agentnum', 'int', '', '',
'agent', 'varchar', '', $char_d,
'typenum', 'int', '', '',
- 'freq', 'smallint', 'NULL', '',
+ 'freq', 'int', 'NULL', '',
'prog', @perl_type,
],
'primary_key' => 'agentnum',
'columns' => [
'custnum', 'int', '', '',
'agentnum', 'int', '', '',
+# 'titlenum', 'int', 'NULL', '',
'last', 'varchar', '', $char_d,
+# 'middle', 'varchar', 'NULL', $char_d,
'first', 'varchar', '', $char_d,
'ss', 'char', 'NULL', 11,
'company', 'varchar', 'NULL', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
'county', 'varchar', 'NULL', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', 'NULL', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
'daytime', 'varchar', 'NULL', 20,
'fax', 'varchar', 'NULL', 12,
'payby', 'char', '', 4,
'payinfo', 'varchar', 'NULL', 16,
- 'paydate', @date_type,
+ #'paydate', @date_type,
+ 'paydate', 'varchar', 'NULL', 10,
'payname', 'varchar', 'NULL', $char_d,
'tax', 'char', 'NULL', 1,
'otaker', 'varchar', '', 8,
'index' => [ ['last'], ],
},
- 'cust_main_county' => { #county+state are checked off the cust_main_county
- #table for validation and to provide a tax rate.
- #add country?
+ 'cust_main_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', 'char', '', 2, #two letters max in US... elsewhere?
- 'county', 'varchar', '', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
+ 'county', 'varchar', 'NULL', $char_d,
+ 'country', 'char', '', 2,
'tax', 'real', '', '', #tax %
],
'primary_key' => 'taxnum',
'address1', 'varchar', '', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', '', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
- 'trancode', 'TINYINT', '', '',
+ 'trancode', 'int', '', '',
'cardnum', 'varchar', '', 16,
- 'exp', @date_type,
+ #'exp', @date_type,
+ 'exp', 'varchar', '', 11,
'payname', 'varchar', 'NULL', $char_d,
'amount', @money_type,
],
'pkg', 'varchar', '', $char_d,
'comment', 'varchar', '', $char_d,
'setup', @perl_type,
- 'freq', 'smallint', '', '', #billing frequency (months)
+ 'freq', 'int', '', '', #billing frequency (months)
'recur', @perl_type,
],
'primary_key' => 'pkgpart',
'index' => [ [] ],
},
+# 'part_title' => {
+# 'columns' => [
+# 'titlenum', 'int', '', '',
+# 'title', 'varchar', '', $char_d,
+# ],
+# 'primary_key' => 'titlenum',
+# 'unique' => [ [] ],
+# 'index' => [ [] ],
+# },
+
'pkg_svc' => {
'columns' => [
'pkgpart', 'int', '', '',
'columns' => [
'popnum', 'int', '', '',
'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
+ 'state', 'varchar', '', $char_d,
'ac', 'char', '', 3,
'exch', 'char', '', 3,
- #rest o' number?
+ 'loc', 'char', 'NULL', 4, #NULL for legacy purposes
],
'primary_key' => 'popnum',
'unique' => [ [] ],
'username', 'varchar', '', $username_len, #unique (& remove dup code)
'_password', 'varchar', '', 25, #13 for encryped pw's plus ' *SUSPENDED*
'popnum', 'int', 'NULL', '',
- 'uid', 'bigint', 'NULL', '',
- 'gid', 'bigint', 'NULL', '',
+ 'uid', 'int', 'NULL', '',
+ 'gid', 'int', 'NULL', '',
'finger', 'varchar', 'NULL', $char_d,
'dir', 'varchar', 'NULL', $char_d,
'shell', 'varchar', 'NULL', $char_d,
'columns' => [
'svcnum', 'int', '', '',
'domsvc', 'int', '', '',
- 'domuid', 'bigint', '', '',
+ 'domuid', 'int', '', '',
'domuser', 'varchar', '', $char_d,
],
'primary_key' => 'svcnum',
# 'index' => [ [] ],
#},
+ 'prepay_credit' => {
+ 'columns' => [
+ 'prepaynum', 'int', '', '',
+ 'identifier', 'varchar', '', $char_d,
+ 'amount', @money_type,
+ ],
+ 'primary_key' => 'prepaynum',
+ 'unique' => [ ['identifier'] ],
+ 'index => [ [] ],
+ },
+
);
%tables;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::prepay_credit;
+
+require 5.004; #srand(time|$$);
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $amount = shift or die &usage;
+
+my $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,
+ };
+ my $error = $prepay_credit->insert;
+ die $error if $error;
+ print "$identifier\n";
+}
+
+sub usage {
+ die "Usage:\n\n generate-prepay user amount num_digits num_entries";
+}
+
#use Pod::Text;
#$Pod::Text::termcap=1;
-my $site_perl = "./site_perl";
+my $site_perl = "./FS";
#my $catman = "./catman";
-my $catman = "./htdocs/docs/man";
-#my $html = "./htdocs/docs/man";
+#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")) {
- $file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
+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";
- system "pod2text $file >$catman/$name.txt";
-# system "pod2html --podpath=$site_perl $file >$html/$name.html";
+ 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";
}
#!/usr/bin/perl -Tw
#
+# $Id: svc_acct.export,v 1.2 1998-12-10 07:23:15 ivan Exp $
+#
# Create and export password files: passwd, passwd.adjunct, shadow,
# acp_passwd, acp_userinfo, acp_dialup, users
#
#
# 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.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 FS::Conf;
use FS::SSH qw(scp ssh);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch fields);
+use FS::svc_acct;
-my($fshellmachines)="/var/spool/freeside/conf/shellmachines";
-my(@shellmachines);
-if ( -e $fshellmachines ) {
- open(SHELLMACHINES,$fshellmachines);
- @shellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/shellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SHELLMACHINES>;
- close SHELLMACHINES;
-}
+my $user = shift or die &usage;
+adminsuidsetup $user;
-my($fbsdshellmachines)="/var/spool/freeside/conf/bsdshellmachines";
-my(@bsdshellmachines);
-if ( -e $fbsdshellmachines ) {
- open(BSDSHELLMACHINES,$fbsdshellmachines);
- @bsdshellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/bsdshellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <BSDSHELLMACHINES>;
- close BSDSHELLMACHINES;
-}
+$conf = new FS::Conf;
-my($fnismachines)="/var/spool/freeside/conf/nismachines";
-my(@nismachines);
-if ( -e $fnismachines ) {
- open(NISMACHINES,$fnismachines);
- @nismachines=map {
- /^(.*)$/ or die "Illegal line in conf/nismachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <NISMACHINES>;
- close NISMACHINES;
-}
+my @shellmachines = $conf->config('shellmachines')
+ if $conf->exists('shellmachines');
-my($ferpcdmachines)="/var/spool/freeside/conf/erpcdmachines";
-my(@erpcdmachines);
-if ( -e $ferpcdmachines ) {
- open(ERPCDMACHINES,$ferpcdmachines);
- @erpcdmachines=map {
- /^(.*)$/ or die "Illegal line in conf/erpcdmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <ERPCDMACHINES>;
- close ERPCDMACHINES;
-}
+my @bsdshellmachines = $conf->config('bsdshellmachines')
+ if $conf->exists('bsdshellmachines');
-my($fradiusmachines)="/var/spool/freeside/conf/radiusmachines";
-my(@radiusmachines);
-if ( -e $fradiusmachines ) {
- open(RADIUSMACHINES,$fradiusmachines);
- @radiusmachines=map {
- /^(.*)$/ or die "Illegal line in conf/radiusmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <RADIUSMACHINES>;
- close RADIUSMACHINES;
-}
+my @nismachines = $conf->config('nismachines')
+ if $conf->exists('nismachines');
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct.export.lock";
+my @erpcdmachines = $conf->config('erpcdmachines')
+ if $conf->exists('erpcdmachines');
-adminsuidsetup;
+my @radiusmachines = $conf->config('radiusmachines')
+ if $conf->exists('radiusmachines');
my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-srand(time|$$);
+require 5.004; #srand(time|$$);
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct.export.lock.". datasrc;
open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
select(EXPORT); $|=1; select(STDOUT);
flock(EXPORT,LOCK_UN);
close EXPORT;
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
#
+# $Id: svc_acct.import,v 1.7 1999-07-08 02:32:26 ivan Exp $
+#
# ivan@sisd.com 98-mar-9
#
# changed 'password' field to '_password' because PgSQL 6.3 reserves this word
# 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.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 FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch);
use FS::svc_acct;
+use FS::part_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix/";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
$FS::svc_acct::nossh_hack = 1;
%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
print "\n\n", &menu_svc, "\n", <<END;
Most accounts probably have entries in passwd and users (with Port-Limit
nonexistant or 1).
print "\n\n", &menu_svc, "\n", <<END;
POP mail accounts have entries in passwd only, and have a particular shell.
END
-print "Enter that shell: ";
-my($pop_shell)=&getvalue;
+my($pop_shell)=&getvalue("Enter that shell:");
my($popmail_svcpart)=&getpart;
print "\n\n", &menu_svc, "\n", <<END;
Enter the location and name of your _user_ passwd file, for example
"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
END
-print ":";
-my($loc_passwd)=&getvalue;
+my($loc_passwd)=&getvalue(":");
iscp("root\@$loc_passwd", "$spooldir/passwd.import");
print "\n\n", <<END;
Enter the location and name of your _user_ shadow file, for example
"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
END
-print ":";
-my($loc_shadow)=&getvalue;
+my($loc_shadow)=&getvalue(":");
iscp("root\@$loc_shadow", "$spooldir/shadow.import");
print "\n\n", <<END;
Enter the location and name of your radius "users" file, for example
"radius.isp.com:/etc/raddb/users"
END
-print ":";
-my($loc_users)=&getvalue;
+my($loc_users)=&getvalue(":");
iscp("root\@$loc_users", "$spooldir/users.import");
sub menu_svc {
( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
}
sub getpart {
- print "Enter part number, or 0 for none: ";
- &getvalue;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
}
print "\n\n";
or die "1Unexpected line in users.import: $_";
my($password,$expiration);
($username,$password,$expiration)=(lc($1),$2,$4);
+ $password = '' if $password eq 'UNIX';
$upassword{$username}=$password;
undef %param;
} else {
while (<USERS>) {
chop;
if ( /^\s*$/ ) {
- $ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
- delete $param{'radius_Framed_IP_Address'};
+ if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+ } else {
+ $ip{$username} = '0e0';
+ }
$allparam{$username}={ %param };
last;
} elsif ( /^\s+([\w\-]+)\s=\s"?([\w\.\-\s]+)"?,?\s*$/ ) {
}
}
#? incase there isn't a terminating blank line ?
-$ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
-delete $param{'radius_Framed_IP_Address'};
+if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+} else {
+ $ip{$username} = '0e0';
+}
$allparam{$username}={ %param };
my(%password);
$svcpart = $shell_svcpart;
}
- my($svc_acct) = create FS::svc_acct ({
+ my($svc_acct) = new FS::svc_acct ({
'svcpart' => $svcpart,
'username' => $username,
'password' => $password,
die "Illegal Port-Limit in users!\n";
}
- my($svc_acct) = create FS::svc_acct ({
+ my($svc_acct) = new FS::svc_acct ({
'svcpart' => $svcpart,
'username' => $username,
'password' => $password,
delete $upassword{$username};
}
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
#
-# Create and export VoiceNet_quasar.m4
+# $Id: svc_acct_sm.export,v 1.2 1998-12-10 07:23: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
#
# 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.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 FS::SSH qw(ssh scp);
-use FS::UID qw(adminsuidsetup);
+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($conf_shellm)="/var/spool/freeside/conf/shellmachine";
-my($fqmailmachines)="/var/spool/freeside/conf/qmailmachines";
my($shellmachine);
my(@qmailmachines);
-if ( -e $fqmailmachines ) {
- open(SHELLMACHINE,$conf_shellm) or die "Can't open $conf_shellm: $!";
- <SHELLMACHINE> =~ /^([\w\.\-]+)$/ or die "Illegal $conf_shellm";
- $shellmachine = $1;
- close SHELLMACHINE;
- open(QMAILMACHINES,$fqmailmachines);
- @qmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/qmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <QMAILMACHINES>;
- close QMAILMACHINES;
+if ( $conf->exists('qmailmachines') ) {
+ $shellmachine = $conf->config('shellmachine');
+ @qmailmachines = $conf->config('qmailmachines');
}
-my($fsendmailmachines)="/var/spool/freeside/conf/sendmailmachines";
-my(@sendmailmachines);
-if ( -e $fsendmailmachines ) {
- open(SENDMAILMACHINES,$fsendmailmachines);
- @sendmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/sendmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SENDMAILMACHINES>;
- close SENDMAILMACHINES;
-}
+my @sendmailmachines = $conf->config('sendmailmachines')
+ if $conf->exists('sendmailmachines');
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
+my $mydomain = $conf->config('domain');
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct_sm.export.lock";
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+my $spoollock = "/usr/local/etc/freeside/svc_acct_sm.export.lock.". datasrc;
-adminsuidsetup;
umask 066;
open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
flock(EXPORT,LOCK_UN);
close EXPORT;
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.export user\n";
+}
+
#!/usr/bin/perl -Tw
#
+# $Id: svc_acct_sm.import,v 1.4 1999-03-25 08:42:20 ivan Exp $
+#
# ivan@sisd.com 98-mar-9
#
# generalized svcparts ivan@sisd.com 98-mar-23
# 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.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 FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch qsearchs);
use FS::svc_acct_sm;
use FS::svc_domain;
+use FS::svc_acct;
+use FS::part_svc;
-adminsuidsetup;
+my $user = shift or die &usage;
+adminsuidsetup $user;
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
my(%mta) = (
1 => "qmail",
%m_part_svc =
map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'});
+die "No services with svcdb svc_domain!\n" unless %d_part_svc;
+die "No services with svcdb svc_svc_acct_sm!\n" unless %m_part_svc;
+
print "\n\n",
( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
- "\n\nEnter part number for domains: ";
-my($domain_svcpart)=&getvalue;
+ "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $domain_svcpart =
+ query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
+$^W=1;
print "\n\n",
( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ),
- "\n\nEnter part number for mail aliases: ";
-my($mailalias_svcpart)=&getvalue;
+ "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $mailalias_svcpart =
+ query "Enter part number for mail aliases: ", 'irk', [ keys %m_part_svc ];
+$^W=1;
print "\n\n", <<END;
Select your MTA from the following list.
END
print join "\n", map "$_: $mta{$_}", sort keys %mta;
-print "\n\n:";
-my($mta)=&getvalue;
+print "\n\n";
+$^W=0; #Term::Query isn't -w-safe
+my $mta = query ":", 'irk', [ keys %mta ];
+$^W=1;
if ( $mta{$mta} eq "qmail" ) {
Enter the location and name of your qmail control directory, for example
"mail.isp.com:/var/qmail/control"
END
- print ":";
- my($control)=&getvalue;
+ my($control)=&getvalue(":");
iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import");
# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import");
iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import");
Enter the location and name of your sendmail virtual user table, for example
"mail.isp.com:/etc/virtusertable"
END
- print ":";
- my($virtusertable)=&getvalue;
+ my($virtusertable)=&getvalue(":");
iscp("root\@$virtusertable","$spooldir/virtusertable.import");
print "\n\n", <<END;
Enter the location and name of your sendmail.cw file, for example
"mail.isp.com:/etc/sendmail.cw"
END
- print ":";
- my($sendmail_cw)=&getvalue;
+ my($sendmail_cw)=&getvalue(":");
iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import");
} else {
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; #Term::Query isn't -w-safe
+ query $prompt, '';
+ $^W=1;
}
print "\n\n";
my $domain = $1;
my($svc_domain);
unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) {
- $svc_domain = create FS::svc_domain ({
+ $svc_domain = new FS::svc_domain ({
'domain' => $domain,
'svcpart' => $domain_svcpart,
'action' => 'N',
}
unless ( exists $svcnum{$domain} ) {
- my($svc_domain) = create FS::svc_domain ({
+ my($svc_domain) = new FS::svc_domain ({
'domain' => $domain,
'svcpart' => $domain_svcpart,
'action' => 'N',
$svcnum{$domain}=$svc_domain->svcnum;
}
- my($svc_acct_sm)=create FS::svc_acct_sm ({
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
'domsvc' => $svcnum{$domain},
'domuid' => $svc_acct->uid,
'domuser' => '*',
die "Unknown user $username in virtusertable";
next;
}
- my($svc_acct_sm)=create FS::svc_acct_sm ({
+ my($svc_acct_sm)=new FS::svc_acct_sm ({
'domsvc' => $svcnum{$domain},
'domuid' => $svc_acct->uid,
'domuser' => $domuser || '*',
$spooldir/virtualdomains !
END
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct_sm.export user\n";
+}
+
Silicon Interactive Software Design
-119 Signal Hill Road
-Holland, PA 18966-2924
+15 Skyview Way
+Newtown, PA 18940
+++ /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
-#!/usr/bin/perl -w
-
-# Template for importing legacy customer data
-#
-# ivan@sisd.com 98-aug-17 - 20
-
-use strict;
-use FS::UID qw(adminsuidsetup datasrc);
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_main;
-use FS::cust_pkg;
-use Date::Parse;
-
-adminsuidsetup;
-
-# 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) = create 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)=create 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) = create 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";
-
+++ /dev/null
-#!/usr/bin/perl
-
-###
-# WHO WROTE THIS???
-###
-
-#require "perldb.pl";
-
-# Compute SLIP/PPP log times
-# Arguments -a Process entire file with totals
-# -t Process only totals
-# -f File to be processed if not current
-# -d processing start date (default is entire file)
-# -l to return all totals for dayuse
-# -w name of tmp work file for dayuse
-# user names
-
-require "time.pl";
-
-$space=' ';
-
-unless (@ARGV[0]) {
- print "Missing Arguments\n";
- print "-a - entire file\n";
- print "-t - totals only\n";
- print "-f - file name to be processed\n";
- print "-d - processing start date (yymmdd)\n";
- print "-l - return totals for dayuse\n";
- print "-w - tmp work file for dayuse\n";
- exit;
-} # end if test for missing arguments
-
-$infile = "/usr/annex/acp_logfile";
-$tmpfile = "/tmp/ppp";
-$n = $#ARGV;
-$start_yymmdd = "";
-for ($i = 0; $i <= $n; $i++) {
- if ($ARGV[$i] eq "-a") {
- $allflag = "true";
- }
- elsif ($ARGV[$i] eq "-t") {
- $totalflag = "true";
- }
- elsif ($ARGV[$i] eq "-f") {
- $i++;
- $infile = $ARGV[$i];
- }
- elsif ($ARGV[$i] eq "-d") {
- $i++;
- $start_yymmdd = $ARGV[$i];
- } #end start yymmdd
- elsif ($ARGV[$i] eq "-l") {
- $logflag = "true";
- $totalflag = "true";
- } # end log
- elsif ($ARGV[$i] eq "-w") {
- $i++;
- $tmpfile = $ARGV[$i];
- } # end tmp file
- else {
- ($arg_user,$arg_yymmdd) = split (/:/, $ARGV[$i]);
- $ip_user_date {$arg_user} = $ARGV[$i];
- $userflag = "true";
- } # end else
- } # end for 1 = 1 to n
-
-open (IN,$infile)
- || die "Can't open acp_logfile";
-
-NEXTUSER: while (<IN>) {
- chop;
- ($add,$ether,$port,$date,$time,$type,$action,$user) = split(/:/);
-
- if ($logflag) {
- $start_yymmdd = '';
- if ($ip_user_date{$user}) {
- ($ip_user, $start_yymmdd) =
- split (/:/, $ip_user_date{$user});
- } # end get date
- } # end log flag
- if ($start_yymmdd) {
- if ($date < $start_yymmdd) {
- next NEXTUSER;
- } #end date compare
- } #end if date
- if ($userflag){
- if (!$ip_user_date{$user}) {
- next NEXTUSER;
- } # end user test
- } # end by user or all
- if (($totalflag) ||
- ($allflag) ||
- ($ip_user_date{$user})) {
- if (($type eq 'ppp') || ($type eq 'slip')) {
-
- if ($action eq 'login') {
- $login{$user} = "$time:$date";
-
- }
- elsif ($action eq 'logout') {
- if (!$login{$user}) {
- $login{$user} = "010101:$date";
- } #end pad user if carry over
- ($stime,$sdate) = split(':',$login{$user});
- $start = &annex2sec($stime);
- $end = &annex2sec($time);
-
- #If we went through midnight, add a day;
- if ($end < $start) {$end += 86400;}
- $timeon = $end - $start;
-
- $elapsed{$user} += $timeon;
-
- if (!$totalflag) {
- print (&fmt_user($user),
- ' ', &fmt_date($sdate), ' In: ',
- &fmt_time($stime),' Out: ',
- &fmt_time($time),
- ' Elapsed: ', &fmt_sec($timeon), "\n");
- } # end total test
- } #end elsif action
- } # type = ppp of slip
- } # check arguments
-}
-close IN;
-
-if ($logflag) {
- open (TMPPPP, ">$tmpfile")
- || die "Can't open ppp tmp file";
- foreach $user ( sort((keys(%elapsed))) ) {
- $log_time = &fmt_sec($elapsed{$user});
- $tmp = join (':',
- $user,
- $log_time);
- print (TMPPPP "$tmp\n");
- }
- close (TMPPPP);
-}
- else {
- print "\n\nTotal Time On For Period:\n";
- print "-------------------------\n";
-
- foreach $user ( sort((keys(%elapsed))) ) {
- print (&fmt_user($user), " ",&fmt_sec($elapsed{$user}), "\n");
- }
- }
-exit(0);
-
-#-------------------------------------------------------
-#--------------- Subroutines Start Here ----------------
-#-------------------------------------------------------
-
-sub annex2sec {
- local($time) = @_;
- return( &time2sec( &break_annex($time) ) );
-}
-
-sub fmt_date {
- local($date) = @_;
-
- return( substr($date,2,2).'/'.substr($date,4,2).'/'.substr($date,0,2) );
-}
-
-sub fmt_time {
- local($time) = @_;
- local($s,$m,$h) = &break_annex($time);
- return ("$h:$m:$s");
-}
-
-
-sub break_annex {
- local($time) = @_;
- local($h,$m,$s);
-
- $h=substr($time,0,2);
- $m=substr($time,2,2);
- $s=substr($time,4,2);
-
- return ($s,$m,$h);
-}
-
-sub fmt_sec {
- local(@t) = &sec2time(@_);
- @t[2] += (@t[3]*24);
-
- foreach $a (@t) {
- if ($a < 10) {$a = "0$a";}
- }
-
- return ("@t[2]:@t[1]:@t[0]");
-}
-
-sub fmt_user {
- local($user) = @_;
- return( $user.substr($space,0,8 - length($user) ).' ' );
-}
-
+++ /dev/null
-AFGHANISTAN AF AFG 004
-ALBANIA AL ALB 008
-ALGERIA DZ DZA 012
-AMERICAN SAMOA AS ASM 016
-ANDORRA AD AND 020
-ANGOLA AO AGO 024
-ANGUILLA AI AIA 660
-ANTARCTICA AQ ATA 010
-ANTIGUA AND BARBUDA AG ATG 028
-ARGENTINA AR ARG 032
-ARMENIA AM ARM 051
-ARUBA AW ABW 533
-AUSTRALIA AU AUS 036
-AUSTRIA AT AUT 040
-AZERBAIJAN AZ AZE 031
-BAHAMAS BS BHS 044
-BAHRAIN BH BHR 048
-BANGLADESH BD BGD 050
-BARBADOS BB BRB 052
-BELARUS BY BLR 112
-BELGIUM BE BEL 056
-BELIZE BZ BLZ 084
-BENIN BJ BEN 204
-BERMUDA BM BMU 060
-BHUTAN BT BTN 064
-BOLIVIA BO BOL 068
-BOSNIA AND HERZEGOWINA BA BIH 070
-BOTSWANA BW BWA 072
-BOUVET ISLAND BV BVT 074
-BRAZIL BR BRA 076
-BRITISH INDIAN OCEAN TERRITORY IO IOT 086
-BRUNEI DARUSSALAM BN BRN 096
-BULGARIA BG BGR 100
-BURKINA FASO BF BFA 854
-BURUNDI BI BDI 108
-CAMBODIA KH KHM 116
-CAMEROON CM CMR 120
-CANADA CA CAN 124
-CAPE VERDE CV CPV 132
-CAYMAN ISLANDS KY CYM 136
-CENTRAL AFRICAN REPUBLIC CF CAF 140
-CHAD TD TCD 148
-CHILE CL CHL 152
-CHINA CN CHN 156
-CHRISTMAS ISLAND CX CXR 162
-COCOS (KEELING) ISLANDS CC CCK 166
-COLOMBIA CO COL 170
-COMOROS KM COM 174
-CONGO CG COG 178
-COOK ISLANDS CK COK 184
-COSTA RICA CR CRI 188
-COTE D'IVOIRE CI CIV 384
-CROATIA (local name: Hrvatska) HR HRV 191
-CUBA CU CUB 192
-CYPRUS CY CYP 196
-CZECH REPUBLIC CZ CZE 203
-DENMARK DK DNK 208
-DJIBOUTI DJ DJI 262
-DOMINICA DM DMA 212
-DOMINICAN REPUBLIC DO DOM 214
-EAST TIMOR TP TMP 626
-ECUADOR EC ECU 218
-EGYPT EG EGY 818
-EL SALVADOR SV SLV 222
-EQUATORIAL GUINEA GQ GNQ 226
-ERITREA ER ERI 232
-ESTONIA EE EST 233
-ETHIOPIA ET ETH 231
-FALKLAND ISLANDS (MALVINAS) FK FLK 238
-FAROE ISLANDS FO FRO 234
-FIJI FJ FJI 242
-FINLAND FI FIN 246
-FRANCE FR FRA 250
-FRANCE, METROPOLITAN FX FXX 249
-FRENCH GUIANA GF GUF 254
-FRENCH POLYNESIA PF PYF 258
-FRENCH SOUTHERN TERRITORIES TF ATF 260
-GABON GA GAB 266
-GAMBIA GM GMB 270
-GEORGIA GE GEO 268
-GERMANY DE DEU 276
-GHANA GH GHA 288
-GIBRALTAR GI GIB 292
-GREECE GR GRC 300
-GREENLAND GL GRL 304
-GRENADA GD GRD 308
-GUADELOUPE GP GLP 312
-GUAM GU GUM 316
-GUATEMALA GT GTM 320
-GUINEA GN GIN 324
-GUINEA-BISSAU GW GNB 624
-GUYANA GY GUY 328
-HAITI HT HTI 332
-HEARD AND MC DONALD ISLANDS HM HMD 334
-HONDURAS HN HND 340
-HONG KONG HK HKG 344
-HUNGARY HU HUN 348
-ICELAND IS ISL 352
-INDIA IN IND 356
-INDONESIA ID IDN 360
-IRAN (ISLAMIC REPUBLIC OF) IR IRN 364
-IRAQ IQ IRQ 368
-IRELAND IE IRL 372
-ISRAEL IL ISR 376
-ITALY IT ITA 380
-JAMAICA JM JAM 388
-JAPAN JP JPN 392
-JORDAN JO JOR 400
-KAZAKHSTAN KZ KAZ 398
-KENYA KE KEN 404
-KIRIBATI KI KIR 296
-KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF KP PRK 408
-KOREA, REPUBLIC OF KR KOR 410
-KUWAIT KW KWT 414
-KYRGYZSTAN KG KGZ 417
-LAO PEOPLE'S DEMOCRATIC REPUBLIC LA LAO 418
-LATVIA LV LVA 428
-LEBANON LB LBN 422
-LESOTHO LS LSO 426
-LIBERIA LR LBR 430
-LIBYAN ARAB JAMAHIRIYA LY LBY 434
-LIECHTENSTEIN LI LIE 438
-LITHUANIA LT LTU 440
-LUXEMBOURG LU LUX 442
-MACAU MO MAC 446
-MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF MK MKD 807
-MADAGASCAR MG MDG 450
-MALAWI MW MWI 454
-MALAYSIA MY MYS 458
-MALDIVES MV MDV 462
-MALI ML MLI 466
-MALTA MT MLT 470
-MARSHALL ISLANDS MH MHL 584
-MARTINIQUE MQ MTQ 474
-MAURITANIA MR MRT 478
-MAURITIUS MU MUS 480
-MAYOTTE YT MYT 175
-MEXICO MX MEX 484
-MICRONESIA, FEDERATED STATES OF FM FSM 583
-MOLDOVA, REPUBLIC OF MD MDA 498
-MONACO MC MCO 492
-MONGOLIA MN MNG 496
-MONTSERRAT MS MSR 500
-MOROCCO MA MAR 504
-MOZAMBIQUE MZ MOZ 508
-MYANMAR MM MMR 104
-NAMIBIA NA NAM 516
-NAURU NR NRU 520
-NEPAL NP NPL 524
-NETHERLANDS NL NLD 528
-NETHERLANDS ANTILLES AN ANT 530
-NEW CALEDONIA NC NCL 540
-NEW ZEALAND NZ NZL 554
-NICARAGUA NI NIC 558
-NIGER NE NER 562
-NIGERIA NG NGA 566
-NIUE NU NIU 570
-NORFOLK ISLAND NF NFK 574
-NORTHERN MARIANA ISLANDS MP MNP 580
-NORWAY NO NOR 578
-OMAN OM OMN 512
-PAKISTAN PK PAK 586
-PALAU PW PLW 585
-PANAMA PA PAN 591
-PAPUA NEW GUINEA PG PNG 598
-PARAGUAY PY PRY 600
-PERU PE PER 604
-PHILIPPINES PH PHL 608
-PITCAIRN PN PCN 612
-POLAND PL POL 616
-PORTUGAL PT PRT 620
-PUERTO RICO PR PRI 630
-QATAR QA QAT 634
-REUNION RE REU 638
-ROMANIA RO ROM 642
-RUSSIAN FEDERATION RU RUS 643
-RWANDA RW RWA 646
-SAINT KITTS AND NEVIS KN KNA 659
-SAINT LUCIA LC LCA 662
-SAINT VINCENT AND THE GRENADINES VC VCT 670
-SAMOA WS WSM 882
-SAN MARINO SM SMR 674
-SAO TOME AND PRINCIPE ST STP 678
-SAUDI ARABIA SA SAU 682
-SENEGAL SN SEN 686
-SEYCHELLES SC SYC 690
-SIERRA LEONE SL SLE 694
-SINGAPORE SG SGP 702
-SLOVAKIA (Slovak Republic) SK SVK 703
-SLOVENIA SI SVN 705
-SOLOMON ISLANDS SB SLB 090
-SOMALIA SO SOM 706
-SOUTH AFRICA ZA ZAF 710
-SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS GS SGS 239
-SPAIN ES ESP 724
-SRI LANKA LK LKA 144
-ST. HELENA SH SHN 654
-ST. PIERRE AND MIQUELON PM SPM 666
-SUDAN SD SDN 736
-SURINAME SR SUR 740
-SVALBARD AND JAN MAYEN ISLANDS SJ SJM 744
-SWAZILAND SZ SWZ 748
-SWEDEN SE SWE 752
-SWITZERLAND CH CHE 756
-SYRIAN ARAB REPUBLIC SY SYR 760
-TAIWAN, PROVINCE OF CHINA TW TWN 158
-TAJIKISTAN TJ TJK 762
-TANZANIA, UNITED REPUBLIC OF TZ TZA 834
-THAILAND TH THA 764
-TOGO TG TGO 768
-TOKELAU TK TKL 772
-TONGA TO TON 776
-TRINIDAD AND TOBAGO TT TTO 780
-TUNISIA TN TUN 788
-TURKEY TR TUR 792
-TURKMENISTAN TM TKM 795
-TURKS AND CAICOS ISLANDS TC TCA 796
-TUVALU TV TUV 798
-UGANDA UG UGA 800
-UKRAINE UA UKR 804
-UNITED ARAB EMIRATES AE ARE 784
-UNITED KINGDOM GB GBR 826
-UNITED STATES US USA 840
-UNITED STATES MINOR OUTLYING ISLANDS UM UMI 581
-URUGUAY UY URY 858
-UZBEKISTAN UZ UZB 860
-VANUATU VU VUT 548
-VATICAN CITY STATE (HOLY SEE) VA VAT 336
-VENEZUELA VE VEN 862
-VIET NAM VN VNM 704
-VIRGIN ISLANDS (BRITISH) VG VGB 092
-VIRGIN ISLANDS (U.S.) VI VIR 850
-WALLIS AND FUTUNA ISLANDS WF WLF 876
-WESTERN SAHARA EH ESH 732
-YEMEN YE YEM 887
-YUGOSLAVIA YU YUG 891
-ZAIRE ZR ZAR 180
-ZAMBIA ZM ZMB 894
-ZIMBABWE ZW ZWE 716
+++ /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/local/bin/perl
-
-###
-# THIS IS FROM CYBERCASH (is there a newer version?)
-###
-
-$paymentserverhost = 'localhost';
-$paymentserverport = 8000;
-$paymentserversecret = 'two-turntables';
-use CCLib qw(sendmserver);
-
-# first lets fake up some data
-# use time of day and pid to give me my pretend
-# order number
-# you obviously need to get real data from somewhere...
-
-$oid = "test$$"; #fake order number.
-$amount = 'usd 42.42';
-$ramount = 'usd 24.24';
-$pan = '4111111111111111';
-$name = 'John Q. Doe';
-$addr = '17 Richard Rd.';
-$city = 'Ivyland';
-$state = 'PA';
-$zip = '18974';
-$country = 'USA';
-$exp = '7/97';
-
-
-%result = &sendmserver('mauthcapture',
- 'Order-ID', $oid,
- 'Amount', $amount,
- 'Card-Number', $pan,
- 'Card-Name', $name,
- 'Card-Address', $addr,
- 'Card-City', $city,
- 'Card-State', $state,
- 'Card-Zip', $zip,
- 'Card-Country', $country,
- 'Card-Exp', $exp);
-
-#
-# just dump results to stdout.
-# you should process them...
-# to allow results to affect operation of your fulfillment...
-#
-foreach (keys(%result)) {
- print " $_ ==> $result{$_}\n";
-}
-
-print "\n";
-
-exit;
-
-$trans=$result{'MTransactionNumber'};
-$code=$result{'MRetrievalCode'};
-
-%result = &sendmserver('return',
- 'Order-ID', $oid,
- 'Return-Amount',$ramount,
- 'Amount',$amount,
- );
-
-foreach (keys(%result)) {
- print " $_ ==> $result{$_}\n";
-}
-
+++ /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 FS::SSH qw(sshopen2);
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_acct;
-
-$SIG{CHLD} = sub { wait() };
-
-&adminsuidsetup;
-
-my($fs_passwdd)="/usr/local/sbin/fs_passwdd";
-
-my($shellmachine)=shift;
-die "Usage: fs_passwd_server shellmachine\n" unless $shellmachine;
-
-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) = create 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";
-}
-
+++ /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/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
-#!/usr/bin/perl -Tw
-#
-# agent.cgi: browse agent
-#
-# ivan@sisd.com 97-dec-12
-#
-# changes to allow pages to load from a relative location in the web tree.
-# bmccane@maxbaud.net 98-mar-25
-#
-# changed 'type' to 'atype' because type is reserved word in Pg6.3
-# bmccane@maxbaud.net 98-apr-3
-#
-# agent type was linking to wrong cgi ivan@sisd.com 98-jul-18
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header('Agent Listing', menubar(
- 'Main Menu' => '../',
- 'Add new agent' => '../edit/agent.cgi'
-)), <<END;
- <BR>
- Click on agent number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>Agent #</FONT></TH>
- <TH>Agent</TH>
- <TH>Type</TH>
- <TH><FONT SIZE=-1>Freq. (unimp.)</FONT></TH>
- <TH><FONT SIZE=-1>Prog. (unimp.)</FONT></TH>
- </TR>
-END
-
-my($agent);
-foreach $agent ( sort {
- $a->getfield('agentnum') <=> $b->getfield('agentnum')
-} qsearch('agent',{}) ) {
- my($hashref)=$agent->hashref;
- my($typenum)=$hashref->{typenum};
- my($agent_type)=qsearchs('agent_type',{'typenum'=>$typenum});
- my($atype)=$agent_type->getfield('atype');
- print <<END;
- <TR>
- <TD><A HREF="../edit/agent.cgi?$hashref->{agentnum}">
- $hashref->{agentnum}</A></TD>
- <TD>$hashref->{agent}</TD>
- <TD><A HREF="../edit/agent_type.cgi?$typenum">$atype</A></TD>
- <TD>$hashref->{freq}</TD>
- <TD>$hashref->{prog}</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent_type.cgi: browse agent_type
-#
-# ivan@sisd.com 97-dec-10
-#
-# Changes to allow page to work at a relative position in server
-# Changes to make "Packages" display 2-wide in table (old way was too vertical)
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-print header("Agent Type Listing", menubar(
- 'Main Menu' => '../',
- 'Add new agent type' => "../edit/agent_type.cgi",
-)), <<END;
- <BR>Click on agent type number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>Type #</FONT></TH>
- <TH>Type</TH>
- <TH colspan="2">Packages</TH>
- </TR>
-END
-
-my($agent_type);
-foreach $agent_type ( sort {
- $a->getfield('typenum') <=> $b->getfield('typenum')
-} qsearch('agent_type',{}) ) {
- my($hashref)=$agent_type->hashref;
- my(@type_pkgs)=qsearch('type_pkgs',{'typenum'=> $hashref->{typenum} });
- my($rowspan)=scalar(@type_pkgs);
- $rowspan = int($rowspan/2+0.5) ;
- print <<END;
- <TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/agent_type.cgi?$hashref->{typenum}">
- $hashref->{typenum}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{atype}</TD>
-END
-
- my($type_pkgs);
- my($tdcount) = -1 ;
- foreach $type_pkgs ( @type_pkgs ) {
- my($pkgpart)=$type_pkgs->getfield('pkgpart');
- my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart });
- print qq!<TR>! if ($tdcount == 0) ;
- $tdcount = 0 if ($tdcount == -1) ;
- print qq!<TD><A HREF="../edit/part_pkg.cgi?$pkgpart">!,
- $part_pkg->getfield('pkg'),"</A></TD>";
- $tdcount ++ ;
- if ($tdcount == 2)
- {
- print qq!</TR>\n! ;
- $tdcount = 0 ;
- }
- }
-
- print "</TR>";
-}
-
-print <<END;
- </TR></TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main_county.cgi: browse cust_main_county
-#
-# ivan@sisd.com 97-dec-13
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header("Tax Rate Listing", menubar(
- 'Main Menu' => '../',
- 'Edit tax rates' => "../edit/cust_main_county.cgi",
-)),<<END;
- <BR>Click on <u>expand</u> to specify tax rates by county.
- <P><TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>State</FONT></TH>
- <TH>County</TH>
- <TH><FONT SIZE=-1>Tax</FONT></TH>
- </TR>
-END
-
-my($cust_main_county);
-foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
- my($hashref)=$cust_main_county->hashref;
- print <<END;
- <TR>
- <TD>$hashref->{state}</TD>
-END
-
- print "<TD>", $hashref->{county}
- ? $hashref->{county}
- : qq!(ALL) <FONT SIZE=-1>!.
- qq!<A HREF="../edit/cust_main_county-expand.cgi?!. $hashref->{taxnum}.
- qq!">expand</A></FONT>!
- , "</TD>";
-
- print <<END;
- <TD>$hashref->{tax}%</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_svc.cgi: browse part_pkg
-#
-# ivan@sisd.com 97-dec-5,9
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-print header("Package Part Listing",menubar(
- 'Main Menu' => '../',
- 'Add new package' => "../edit/part_pkg.cgi",
-)), <<END;
- <BR>Click on package part number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>Part #</FONT></TH>
- <TH>Package</TH>
- <TH>Comment</TH>
- <TH><FONT SIZE=-1>Setup Fee</FONT></TH>
- <TH><FONT SIZE=-1>Freq.</FONT></TH>
- <TH><FONT SIZE=-1>Recur. Fee</FONT></TH>
- <TH>Service</TH>
- <TH><FONT SIZE=-1>Quan.</FONT></TH>
- </TR>
-END
-
-my($part_pkg);
-foreach $part_pkg ( sort {
- $a->getfield('pkgpart') <=> $b->getfield('pkgpart')
-} qsearch('part_pkg',{}) ) {
- my($hashref)=$part_pkg->hashref;
- my(@pkg_svc)=grep $_->getfield('quantity'),
- qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} });
- my($rowspan)=scalar(@pkg_svc);
- print <<END;
- <TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/part_pkg.cgi?$hashref->{pkgpart}">
- $hashref->{pkgpart}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{pkg}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{comment}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{setup}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{freq}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{recur}</TD>
-END
-
- my($pkg_svc);
- foreach $pkg_svc ( @pkg_svc ) {
- my($svcpart)=$pkg_svc->getfield('svcpart');
- my($part_svc) = qsearchs('part_svc',{'svcpart'=> $svcpart });
- print qq!<TD><A HREF="../edit/part_svc.cgi?$svcpart">!,
- $part_svc->getfield('svc'),"</A></TD><TD>",
- $pkg_svc->getfield('quantity'),"</TD></TR><TR>\n";
- }
-
- print "</TR>";
-}
-
-print <<END;
- </TR></TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_referral.cgi: Browse part_referral
-#
-# ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header("Referral Listing", menubar(
- 'Main Menu' => '../',
- 'Add new referral' => "../edit/part_referral.cgi",
-)), <<END;
- <BR>Click on referral number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>Referral #</FONT></TH>
- <TH>Referral</TH>
- </TR>
-END
-
-my($part_referral);
-foreach $part_referral ( sort {
- $a->getfield('refnum') <=> $b->getfield('refnum')
-} qsearch('part_referral',{}) ) {
- my($hashref)=$part_referral->hashref;
- print <<END;
- <TR>
- <TD><A HREF="../edit/part_referral.cgi?$hashref->{refnum}">
- $hashref->{refnum}</A></TD>
- <TD>$hashref->{referral}</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_svc.cgi: browse part_svc
-#
-# ivan@sisd.com 97-nov-14, 97-dec-9
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch);
-use FS::part_svc qw(fields);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header('Service Part Listing', menubar(
- 'Main Menu' => '../',
- 'Add new service' => "../edit/part_svc.cgi",
-)),<<END;
- <BR>Click on service part number to edit.
- <TABLE BORDER>
- <TR>
- <TH>Part #</TH>
- <TH>Service</TH>
- <TH>Table</TH>
- <TH>Field</TH>
- <TH>Action</TH>
- <TH>Value</TH>
- </TR>
-END
-
-my($part_svc);
-foreach $part_svc ( sort {
- $a->getfield('svcpart') <=> $b->getfield('svcpart')
-} qsearch('part_svc',{}) ) {
- my($hashref)=$part_svc->hashref;
- my($svcdb)=$hashref->{svcdb};
- my(@rows)=
- grep $hashref->{${svcdb}.'__'.$_.'_flag'},
- map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc')
- ;
- my($rowspan)=scalar(@rows);
- print <<END;
- <TR>
- <TD ROWSPAN=$rowspan><A HREF="../edit/part_svc.cgi?$hashref->{svcpart}">
- $hashref->{svcpart}
- </A></TD>
- <TD ROWSPAN=$rowspan>$hashref->{svc}</TD>
- <TD ROWSPAN=$rowspan>$hashref->{svcdb}</TD>
-END
- my($row);
- foreach $row ( @rows ) {
- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print "<TD>$row</TD><TD>";
- if ( $flag eq "D" ) { print "Default"; }
- elsif ( $flag eq "F" ) { print "Fixed"; }
- else { print "(Unknown!)"; }
- print "</TD><TD>",$part_svc->getfield($svcdb."__".$row),"</TD></TR><TR>";
- }
-print "</TR>";
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_pop.cgi: browse pops
-#
-# ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use FS::UID qw(cgisuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header('POP Listing', menubar(
- 'Main Menu' => '../',
- 'Add new POP' => "../edit/svc_acct_pop.cgi",
-)), <<END;
- <BR>Click on pop number to edit.
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>POP #</FONT></TH>
- <TH>City</TH>
- <TH>State</TH>
- <TH>Area code</TH>
- <TH>Exchange</TH>
- </TR>
-END
-
-my($svc_acct_pop);
-foreach $svc_acct_pop ( sort {
- $a->getfield('popnum') <=> $b->getfield('popnum')
-} qsearch('svc_acct_pop',{}) ) {
- my($hashref)=$svc_acct_pop->hashref;
- print <<END;
- <TR>
- <TD><A HREF="../edit/svc_acct_pop.cgi?$hashref->{popnum}">
- $hashref->{popnum}</A></TD>
- <TD>$hashref->{city}</TD>
- <TD>$hashref->{state}</TD>
- <TD>$hashref->{ac}</TD>
- <TD>$hashref->{exch}</TD>
- </TR>
-END
-
-}
-
-print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-ivan@rootwood:~/src/CGI-modules-2.76/CGI$ diff -c Base.pm Base.pm.orig
-*** Base.pm Sat Jul 18 00:33:21 1998
---- Base.pm.orig Sat Jul 18 00:06:12 1998
-***************
-*** 938,945 ****
- my $orig_uri = $self->get_uri;
- $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri")
- if $Debug;
-! my $msg = ($perm) ? StatusHdr(301,"Moved Permanently")
-! : StatusHdr(302,"Moved Temporarily");
- my $hdrs = SendHeaders($msg, LocationHdr($to_uri));
- $self->log($hdrs);
- }
---- 938,945 ----
- my $orig_uri = $self->get_uri;
- $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri")
- if $Debug;
-! my $msg = ($perm) ? ServerHdr(301,"Moved Permanently")
-! : ServerHdr(302,"Moved Temporarily");
- my $hdrs = SendHeaders($msg, LocationHdr($to_uri));
- $self->log($hdrs);
- }
-
+++ /dev/null
-<head>
- <title>Administration</title>
-</head>
-<body>
- <h1>Administration</h1>
-</body>
+++ /dev/null
-<head>
- <title>Billing</title>
-</head>
-<body>
- <h1>Billing</h1>
- The bin/bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d <i>date</i> ] [ -b ]
- <ul>
- <li>-c: Turn on collecting (you probably want this).
- <li>-i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards. Not available without modifying site_perl/Bill.pm
- <li>-d: Pretend it is <i>date</i> (parsed by Date::Parse)
- <li>-b: N/A
- </ul>
- Printing should be configured on your freeside machine to print invoices.
- <br><br>Batch credit card processing
- <ul>
- <li>After this script is run, a credit card batch will be in the <a href="schema.html#cust_pay_batch">cust_pay_batch</a> table. Export this table to your credit card batching.
- <li>When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the <a href="schema.html#cust_pay">cust_pay</a> table. Example code to add payments is:
- <pre>use FS::cust_pay;
-
-# loop over all records in batch
-
-my $payment=create FS::cust_pay (
- 'invnum' => $invnum,
- 'paid' => $paid,
- '_date' => $_date,
- 'payby' => $payby,
- 'payinfo' => $payinfo,
- 'paybatch' => $paybatch,
-);
-
-my $error=$payment->insert;
-if ( $error ) {
- #process error
-}
-
-# end loop
-</pre>
-All fields except paybatch are contained in the cust_pay_batch table. You can use paybatch field to track particular batches and/or particular transactions within a batch.
- </ul>
-</body>
+++ /dev/null
-<head>
- <title>Configuration files</title>
-</head>
-<body>
- <h1>Configuration files</h1>
-Configuration files and directories are located in `/var/spool/freeside/conf'.
-<ul>
- <li>address - Your company name and address, four lines.
- <li>bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'.
- <li>cybercash2 - <a href="http://www.cybercash.com/cybercash/services/cashreg214.html">CyberCash v2</a> support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required.
- <li>cybercash3.2 - <a href="http://www.cybercash.com/cybercash/services/technology.html">CyberCash v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly' or `mauthcapture'). CCMckLib3_2.pm, CCMckDirectLib3_2.pm and CCMckErrno3_2 are required.
- <li>domain - Your domain name.
- <li>erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'.
- <li>home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash.
- <li>lpr - Print command for paper invoices, for example `lpr -h'.
- <li>nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'.
- <li>qmailmachines - Your qmail machines, one per line. This enables export of `/var/qmail/control/virtualdomains', `/var/qmail/control/recipientmap', and `/var/qmail/control/rcpthosts'. The existance of this file (even if empty) also turns on user `.qmail-extension' file maintenance in conjunction with `shellmachine'.
- <li>radiusmachines - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'.
- <li>registries - Directory which contains domain registry information. Each registry is a directory.
- <ul>
- <li>registries/internic - Currently the only supported registry
- <ul>
- <li>registries/internic/from - Email address from which InterNIC domain registrations are sent.
- <li>regestries/internic/nameservers - The nameservers for InterNIC domain registrations, one per line. Each line contains an IP address and hostname, separated by whitespace.
- <li>registries/internic/tech_contact - Technical contact NIC handle for domain registrations.
- <li>registries/internic/template - Template for InterNIC domain registrations with special markup. A suitable copy of the InterNIC domain template v4.0 is in `fs-x.y.z/etc/domain-template.txt'.
- <li>registries/internic/to - Email address to which InterNIC domain registrations are sent.
- </ul>
- </ul>
- <li>secrets - Three lines: Database engine datasource (for example, `DBI:mysql:freeside' or `DBI:Pg:dbname=freeside'), username, and password. This file should not be world readable.
- <li>sendmailmachines - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'.
- <li>shellmachine - A single machine with user home directories mounted. This enables home directory creation, renaming and archiving/deletion. In conjunction with `qmailmachines', it also enables `.qmail-extension' file maintenance.
- <li>shellmachines - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files.
- <li>shells - Legal shells (think /etc/shells). You probably want to `cut -d: -f7 /etc/passwd | sort | uniq' initially so that importing doesn't fail with `Illegal shell' errors, then remove any special entries afterwords. A blank line specifies that an empty shell is permitted.
- <li>smtpmachine - SMTP relay for Freeside's outgoing mail.
-</ul>
-</body>
-
+++ /dev/null
-<head>
- <title>File exporting</title>
-</head>
-<body>
- <h1>File exporting</h1>
- <ul>
- <li>bin/svc_acct.export will create UNIX `passwd', `shadow' and `master.passwd' files, ERPCD `acp_passwd' and `acp_dialup' files and a RADIUS `users' file in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattended; see below.
- <ul>
- <li>shellmachines - passwd and shadow are copied to the remote machine as /etc/passwd.new and /etc/shadow.net and then moved to /etc/passwd and /etc/shadow if no errors occur.
- <li>bsdshellmachines - passwd and master.passwd are copied to the remote machine as /etc/passwd.new and /etc/master.passwd.new and moved to /etc/passwd and /etc/master.passwd if no errors occur.
- <li>nismachines - passwd and shadow are copied to the `/etc/global' directory on the remote machine. If no errors occur, the command `( cd /var/yp; make; )' is executed on the remote machine.
- <li>erpcdmachines - acp_passwd and acp_dialup are copied to the `/usr/annex' directory on the remote machine. If no errors occur, the command `( kill -USR1 `cat /usr/annex/erpcd.pid` )' is executed on the remote machine.
- <li>radiusmachines - users is copied to the `/etc/raddb' directory on the remote machine. If no errors occur, the command `( builddbm )' is executed on the remote machine.
- </ul>
- <li>site_perl/svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below.
- <ul>
- <li>The command `useradd -d <i>homedir</i> -s <i>shell</i> -u <i>uid</i> <i>username</i>' is executed when a user is added.
- <li>The command `userdel <i>username</i>' is executed with a user is deleted.
- <li>If a user's home directory changes, the command `[ -d <i>old_homedir</i> && ( chmod u+t <i>old_homedir</i>; umask 022; mkdir <i>new_homedir</i>; cd <i>old_homedir</i>; find . -depth -print | cpio -pdm <i>new_homedir</i>; chmod u-t <i>new_homedir</i>; chown -R <i>uid</i>.<i>gid</i> <i>new_homedir</i>; rm -rf <i>old_homedir</i> )' is executed.
- </ul>
- <li>bin/svc_acct_sm.export will create <a href="http://www.qmail.org">Qmail</a> `rcpthosts', `recipientmap' and `virtualdomains' files and <a href="http://www.sendmail.org">Sendmail</a> `virtusertable' and `sendmail.cw' files in the `/var/spool/freeside/export' directory. Using the appropriate <a href="config.html">configuration files</a>, you can export these files to your remote machines unattemded; see below.
- <ul>
- <li>qmailmachines - recipientmap, virtualdomains and rcpthosts are copied to the `/var/qmail/control' directory on the remote machine. Note: If you <a href="legacy.html#svc_acct_sm">imported</a> qmail configuration files, run the generated `/var/spool/freeside/export/virtualdomains.FIX' on a machine with your user home directories before exporting qmail configuration files.
- <li>shellmachine - The command `[ -e <i>homedir</i>/.qmail-default ] || { touch <i>homedir</i>/.qmail-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-default; }' will be run on this machine for users in the virtualdomains file.
- <li>sendmailmachines - sendmail.cw and virtusertable are copied to the remote machine as /etc/sendmail.cw.new and /etc/virtusertable.new and moved to /etc/sendmail.cw and /etc/virtusertable if no errors occur.
- </ul>
- <li>site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user `.qmail-' files can be updated.
- <ul>
- <li>The command `[ -e <i>homedir</i>/.qmail-<i>domain</i>-default ] || { touch <i>homedir</i>/.qmail-<i>domain</i>-default; chown <i>uid</i>.<i>gid</i> <i>homedir</i>/.qmail-<i>domain</i>-default; }' is run.
- </ul>
- </ul>
- <br><a name=ssh>Unattended remote login</a> - Freeside can login to remote machines unattended using SSH. This can pose a security risk if not configured correctly, and will allow an intruder who breaks into your freeside machine full access to your remote machines. <b>Do not use this feature unless you understand what you are doing!</b>
- <ul>
- <li>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.nyc.ny.us/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, you need to use a blank passphrase.
- <li>Append the newly-created identity.pub file to root's authorized_keys on the remote machine(s).
- </ul>
-
-</body>
-
+++ /dev/null
-<head>
- <title>Documentation</title>
-</head>
-<body>
- <h1>Documentation</h1>
-<ul>
- <li><a href="install.html">New Installation</a>
- <li><a href="upgrade.html">Upgrading from 1.0.x to 1.1.x</a>
- <li><a href="upgrade2.html">Upgrading from 1.1.x to 1.1.3</a>
- <li><a href="config.html">Configuration files</a>
-<!--
- <li><a href="admin.html">Administration</a>
-!-->
- <li><a href="../index.html#admin">Administration</a>
- <li><a href="legacy.html">Importing legacy data</a>
- <li><a href="export.html">File exporting and remote setup</a>
- <li><a href="passwd.html">fs_passwd</a>
- <li><a href="billing.html">Billing</a>
- <li><a href="trouble.html">Troubleshooting</a>
- <li><a href="schema.html">Schema reference</a>
- <li><a href="man/">Perl API</a>
-</ul>
-</body>
+++ /dev/null
-<head>
- <title>Installation</title>
-</head>
-<body>
-<h1>Installation</h1>
-Before installing, you need:
-<ul>
- <li>A web server, such as <a href="http://www.apache-ssl.org">Apache-SSL</a> or <a href="http://www.apache.org">Apache</a>
- <li><a href="ftp://ftp.cs.hut.fi/pub/ssh/">SSH</a>
- <li>agrep from the <a href="http://glimpse.cs.arizona.edu">Glimpse</a> distribution, if you want fuzzy searching capability
- <li><a href="http://www.perl.com/CPANl/doc/relinfo/INSTALL.html">Perl</a> (at least 5.004_04)
- <li>A database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>, such as <a href="http://www.tcx.se/">MySQL</a> or <a href="http://www.postgresql.org/">PostgreSQL</a>
- <li>Perl modules
- <ul>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/MIME/">MIME-Base64</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Data">Data-Dumper</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/MD5">MD5</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Net">libnet</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/LWP/">libwww-perl</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/CGI/">CGI-modules</a> (<b>NOT</b> CGI.pm) with this <a href="CGI-modules-2.76-patch.txt">patch</a> applied
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Business/">Business-CreditCard</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Data/">Data-ShowTable</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Mail/">MailTools</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Time/">TimeDate</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/Date/">DateManip</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/File/">File-CounterFile</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/FreezeThaw/">FreezeThaw</a>
- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBI/">DBI
- <li><a href="http://www.perl.com/CPAN/modules/by-module/DBD/">DBD for your database engine</a>
- </ul>
-</ul>
-Install the Freeside distribution:
-<ul>
- <li>Add the user `freeside' to your system.
- <li>Add the freeside database to your database engine. (with <a href="http://www.mysql.com/Manual_chapter/manual_Syntax.html#Create database">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/manage-ag.htm#AEN854">PostgreSQL</a>)
- <li>Allow the freeside user full access to the freeside database. (with <a href="http://www.mysql.com/Manual_chapter/manual_Privilege_system.html#Privilege system">MySQL</a>) (with <a href="http://www.postgresql.org/docs/admin/newuser.htm">PostgreSQL</a>)
- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>
- <li>Copy or link fs-x.y.z/site_perl to FS in your site_perl directory. (try `<code>perl -V</code>' if unsure) <pre>mkdir /usr/local/lib/site_perl/FS
-cp fs-x.y.z/site_perl/* /usr/local/lib/site_perl/FS</pre> or <pre>ln -s /full/path/to/fs-x.y.z/site_perl /usr/local/lib/site_perl/FS</pre>
- <li>Copy or link fs-x.y.z/htdocs to your web server's document space. <pre>mkdir /usr/local/apache/htdocs/freeside
-cp -r fs-x.y.z/htdocs/* /usr/local/apache/htdocs/freeside</pre> or <pre>ln -s /full/path/to/fs-x.y.z/htdocs /usr/local/apache/htdocs/freeside</pre>
- <li>Restrict access to this web interface. (with <a href="http://www.apache.org/docs/misc/FAQ.html#user-authentication">Apache</a>)
- <li>Enable CGI execution for files with the `.cgi' extension. (with <a href="http://www.apache.org/docs/mod/mod_mime.html#addhandler">Apache</a>)
- <li>Set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds.
-<pre>cd /usr/local/apache/htdocs/freeside
-chown -R freeside .
-chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
-<li>Create the base Freeside directory `/var/spool/freeside', and the subdirectories `conf', `counters', and `export'. <pre>mkdir /var/spool/freeside
-mkdir /var/spool/freeside/conf
-mkdir /var/spool/freeside/counters
-mkdir /var/spool/freeside/export
-chown -R freeside /var/spool/freeside</pre>
- <li>Create the necessary <a href="config.html">configuration files</a>.
- <li>Run bin/fs-setup to create the database tables.
-</ul>
-</body>
+++ /dev/null
-<head>
- <title>Importing legacy data</title>
-</head>
-<body>
- <h1>Importing legacy data</h1>
-<ul>
- <li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> (with table svc_acct) as follows:
- <ul>
- <li>Most accounts probably have entries in passwd and users (with Port-Limit nonexistant or 1)
- <li>Some accounts have entries in passwd and users, but with Port-Limit 2 (or more)
- <li>Some accounts might have entries in users only (Port-Limit 1)
- <li>Some accounts might have entries in users only (Port-Limit >= 2)
- <li>POP mail accounts have entries in passwd only, and have a particular shell.
- <li>Everything else in passwd is a shell account.
- </ul>
- <li><a name="svc_acct_sm">bin/svc_acct_sm.import</a> - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need <a href="http://rootwood.sisd.com/freeside/browse/part_svc.cgi">services</a> as follows:
- <ul>
- <li>Domain (table svc_acct)
- <li>Mail alias (table svc_acct_sm)
- </ul>
- <li><a name="cust_main">Importing customer data</a>
- <ul>
- <li>Manually
- <ul>
- <li>Add a <a href="../edit/cust_main.cgi">new customer</a>
- <li>Add one or more packages for this customer
- <li>Enter a package by clicking on the package number
- <li>Pick the `Link to existing' option
- </ul>
- <li>Batch - You will need to write a script to import your particular legacy data. You can use eg/TEMPLATE_cust_main.import as a starting point.
- </ul>
-</ul>
-</body>
-
+++ /dev/null
-NAME
- FS::Bill - Legacy stub
-
-SYNOPSIS
- The functionality of FS::Bill has been integrated into
- FS::cust_main.
-
-HISTORY
- ivan@voicenet.com 97-jul-24 - 25 - 28
-
- use Safe; evaluate all fees with perl (still on TODO list until
- I write some examples & test opmask to see if we can read db)
- %hash=$obj->hash later ivan@sisd.com 98-mar-13
-
- packages with no next bill date start at $time not time, this
- should eliminate the last of the problems with billing at a past
- date also rewrite the invoice priting logic not to print
- invoices for things that haven't happended yet and update
- $cust_bill->printed when we print so PAST DUE notices work, and
- s/date/_date/ ivan@sisd.com 98-jun-4
-
- more logic for past due stuff - packages with no next bill date
- start at $cust_pkg->setup || $time ivan@sisd.com 98-jul-13
-
- moved a few things in collection logic; negative charges should
- work ivan@sisd.com 98-aug-6
-
- pod, moved everything to FS::cust_main ivan@sisd.com 98-sep-19
-
+++ /dev/null
-NAME
- FS::CGI - Subroutines for the web interface
-
-SYNOPSIS
- use FS::CGI qw(header menubar idiot eidiot);
-
- print header( 'Title', '' );
- print header( 'Title', menubar('item', 'URL', ... ) );
-
- idiot "error message";
- eidiot "error message";
-
-DESCRIPTION
- Provides a few common subroutines for the web interface.
-
-SUBROUTINES
- header TITLE, MENUBAR
- Returns an HTML header.
-
- menubar ITEM, URL, ...
- Returns an HTML menubar.
-
- idiot ERROR
- Sends headers and an HTML error message.
-
- eidiot ERROR
- Sends headers and an HTML error message, then exits.
-
-BUGS
- Not OO.
-
- Not complete.
-
- Uses CGI-modules instead of CGI.pm
-
-SEE ALSO
- the CGI::Base manpage
-
-HISTORY
- subroutines for the HTML/CGI GUI, not properly OO. :(
-
- ivan@sisd.com 98-apr-16 ivan@sisd.com 98-jun-22
-
- lose the background, eidiot ivan@sisd.com 98-sep-2
-
- pod ivan@sisd.com 98-sep-12
-
+++ /dev/null
-NAME
- FS::Conf - Read access to Freeside configuration values
-
-SYNOPSIS
- use FS::Conf;
-
- $conf = new FS::Conf;
- $conf = new FS::Conf "/non/standard/config/directory";
-
- $dir = $conf->dir;
-
- $value = $conf->config('key');
- @list = $conf->config('key');
- $bool = $conf->exists('key');
-
-DESCRIPTION
- Read access to Freeside configuration values. Keys currently map
- to filenames, but this may change in the future.
-
-METHODS
- new [ DIRECTORY ]
- Create a new configuration object. Optionally, a non-default
- directory may be specified.
-
- dir Returns the directory.
-
- config
- Returns the configuration value or values (depending on
- context) for key.
-
- exists
- Returns true if the specified key exists, even if the
- corresponding value is undefined.
-
-BUGS
- The option to specify a non-default directory should probably be
- removed.
-
- Write access (with locking) should be implemented.
-
-SEE ALSO
- config.html from the base documentation contains a list of
- configuration files.
-
-HISTORY
- Ivan Kohler <ivan@sisd.com> 98-sep-6
-
+++ /dev/null
-NAME
- FS::Invoice - Legacy stub
-
-SYNOPSIS
- The functioanlity of FS::invoice has been integrated in
- FS::cust_bill.
-
-HISTORY
- ivan@voicenet.com 97-jun-25 - 27
-
- maybe should be changed to be OO-functions on $cust_bill
- objects? (instead of passing invnum, ugh).
-
- ISA cust_bill and return inovice instead of passing filehandle
- ivan@sisd.com 98-mar-13 (add postscript output!)
-
- close our kid when we're done ivan@sisd.com 98-jun-4
-
- separated code which shuffled data from code which formatted.
- (so i could) fixed past due notices showing up when balance due
- =< 0 return address comes from /var/spool/freeside/conf/address
- ivan@sisd.com 98-jul-2
-
+++ /dev/null
-NAME
- FS::Record - Database record objects
-
-SYNOPSIS
- use FS::Record;
- use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
-
- $record = new FS::Record 'table', \%hash;
- $record = new FS::Record 'table', { 'column' => 'value', ... };
-
- $record = qsearchs FS::Record 'table', \%hash;
- $record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
- @records = qsearch FS::Record 'table', \%hash;
- @records = qsearch FS::Record 'table', { 'column' => 'value', ... };
-
- $table = $record->table;
- $dbdef_table = $record->dbdef_table;
-
- $value = $record->get('column');
- $value = $record->getfield('column');
- $value = $record->column;
-
- $record->set( 'column' => 'value' );
- $record->setfield( 'column' => 'value' );
- $record->column('value');
-
- %hash = $record->hash;
-
- $hashref = $record->hashref;
-
- $error = $record->add;
-
- $error = $record->del;
-
- $error = $new_record->rep($old_record);
-
- $value = $record->unique('column');
-
- $value = $record->ut_float('column');
- $value = $record->ut_number('column');
- $value = $record->ut_numbern('column');
- $value = $record->ut_money('column');
- $value = $record->ut_text('column');
- $value = $record->ut_textn('column');
- $value = $record->ut_alpha('column');
- $value = $record->ut_alphan('column');
- $value = $record->ut_phonen('column');
- $value = $record->ut_anythingn('column');
-
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
-
- $quoted_value = _quote($value,'table','field');
-
- #depriciated
- $fields = hfields('table');
- if ( $fields->{Field} ) { # etc.
-
- @fields = fields 'table';
-
-DESCRIPTION
- (Mostly) object-oriented interface to database records. Records
- are currently implemented on top of DBI. FS::Record is intended
- as a base class for table-specific classes to inherit from, i.e.
- FS::cust_main.
-
-METHODS
- new TABLE, HASHREF
- Creates a new record. It doesn't store it in the database,
- though. See the section on "add" for that.
-
- Note that the object stores this hash reference, not a
- distinct copy of the hash it points to. You can ask the
- object for a copy with the *hash* method.
-
- qsearch TABLE, HASHREF
- Searches the database for all records matching (at least)
- the key/value pairs in HASHREF. Returns all the records
- found as FS::Record objects.
-
- qsearchs TABLE, HASHREF
- Searches the database for a record matching (at least) the
- key/value pairs in HASHREF, and returns the record found as
- an FS::Record object. If more than one record matches, it
- carps but returns the first. If this happens, you either
- made a logic error in asking for a single item, or your data
- is corrupted.
-
- table
- Returns the table name.
-
- dbdef_table
- Returns the FS::dbdef_table object for the table.
-
- get, getfield COLUMN
- Returns the value of the column/field/key COLUMN.
-
- set, setfield COLUMN, VALUE
- Sets the value of the column/field/key COLUMN to VALUE.
- Returns VALUE.
-
- AUTLOADED METHODS
- $record->column is a synonym for $record->get('column');
-
- $record->column('value') is a synonym for $record-
- >set('column','value');
-
- hash
- Returns a list of the column/value pairs, usually for
- assigning to a new hash.
-
- To make a distinct duplicate of an FS::Record object, you
- can do:
-
- $new = new FS::Record ( $old->table, { $old->hash } );
-
- hashref
- Returns a reference to the column/value hash.
-
- add Adds this record to the database. If there is an error, returns
- the error, otherwise returns false.
-
- del Delete this record from the database. If there is an error,
- returns the error, otherwise returns false.
-
- rep OLD_RECORD
- Replace the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- unique COLUMN
- Replaces COLUMN in record with a unique number. Called by
- the add method on primary keys and single-field unique
- columns (see the FS::dbdef_table manpage). Returns the new
- value.
-
- ut_float COLUMN
- Check/untaint floating point numeric data: 1.1, 1, 1.1e10,
- 1e10. May not be null. If there is an error, returns the
- error, otherwise returns false.
-
- ut_number COLUMN
- Check/untaint simple numeric data (whole numbers). May not
- be null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_numbern COLUMN
- Check/untaint simple numeric data (whole numbers). May be
- null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_money COLUMN
- Check/untaint monetary numbers. May be negative. Set to 0 if
- null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_text COLUMN
- Check/untaint text. Alphanumerics, spaces, and the following
- punctuation symbols are currently permitted: ! @ # $ % & ( )
- - + ; : ' " , . ? / May not be null. If there is an error,
- returns the error, otherwise returns false.
-
- ut_textn COLUMN
- Check/untaint text. Alphanumerics, spaces, and the following
- punctuation symbols are currently permitted: ! @ # $ % & ( )
- - + ; : ' " , . ? / May be null. If there is an error,
- returns the error, otherwise returns false.
-
- ut_alpha COLUMN
- Check/untaint alphanumeric strings (no spaces). May not be
- null. If there is an error, returns the error, otherwise
- returns false.
-
- ut_alpha COLUMN
- Check/untaint alphanumeric strings (no spaces). May be null.
- If there is an error, returns the error, otherwise returns
- false.
-
- ut_phonen COLUMN
- Check/untaint phone numbers. May be null. If there is an
- error, returns the error, otherwise returns false.
-
- ut_anything COLUMN
- Untaints arbitrary data. Be careful.
-
-SUBROUTINES
- reload_dbdef([FILENAME])
- Load a database definition (see the FS::dbdef manpage),
- optionally from a non-default filename. This command is
- executed at startup unless *$FS::Record::setup_hack* is
- true. Returns a FS::dbdef object.
-
- dbdef Returns the current database definition. See the FS::dbdef
- manpage.
-
- _quote VALUE, TABLE, COLUMN
- This is an internal function used to construct SQL
- statements. It returns VALUE DBI-quoted (see the section
- on "quote" in the DBI manpage) unless VALUE is a number
- and the column type (see the dbdef_column manpage) does
- not end in `char' or `binary'.
-
- hfields TABLE
- This is depriciated. Don't use it.
-
- It returns a hash-type list with the fields of this
- record's table set true.
-
- fields TABLE
- This returns a list of the columns in this record's
- table (See the dbdef_table manpage).
-
-BUGS
- This module should probably be renamed, since much of the
- functionality is of general use. It is not completely unlike
- Adapter::DBI (see below).
-
- Exported qsearch and qsearchs should be depriciated in favor
- of method calls (against an FS::Record object like the old
- search and searchs that qsearch and qsearchs were on top
- of.)
-
- The whole fields / hfields mess should be removed.
-
- The various WHERE clauses should be subroutined.
-
- table string should be depriciated in favor of
- FS::dbdef_table.
-
- No doubt we could benefit from a Tied hash. Documenting how
- exists / defined true maps to the database (and WHERE
- clauses) would also help.
-
- The ut_ methods should ask the dbdef for a default length.
-
- ut_sqltype (like ut_varchar) should all be defined
-
- A fallback check method should be provided with uses the
- dbdef.
-
- The ut_money method assumes money has two decimal digits.
-
- The Pg money kludge in the new method only strips `$'.
-
- The ut_phonen method assumes US-style phone numbers.
-
- The _quote function should probably use ut_float instead of
- a regex.
-
- All the subroutines probably should be methods, here or
- elsewhere.
-
-SEE ALSO
- the FS::dbdef manpage, the FS::UID manpage, the DBI manpage
-
- Adapter::DBI from Ch. 11 of Advanced Perl Programming by
- Sriram Srinivasan.
-
-HISTORY
- ivan@voicenet.com 97-jun-2 - 9, 19, 25, 27, 30
-
- DBI version ivan@sisd.com 97-nov-8 - 12
-
- cleaned up, added autoloaded $self->any_field calls, moved
- DBI login stuff to FS::UID ivan@sisd.com 97-nov-21-23
-
- since AUTO_INCREMENT is MySQL specific, use my own unique
- number generator (again) ivan@sisd.com 97-dec-4
-
- untaint $user in unique (web demo hack...bah) make unique
- skip multiple-field unique's from dbdef ivan@sisd.com 97-
- dec-11
-
- merge with FS::Search, which after all was just alternate
- constructors for FS::Record objects. Makes lots of things
- cleaner. :) ivan@sisd.com 97-dec-13
-
- use FS::dbdef::primary key in replace searches, hopefully
- for all practical purposes the string/number problem in SQL
- statements should be gone? (SQL bites) ivan@sisd.com 98-jan-
- 20
-
- Put all SQL statments in $statment before we $sth=$dbh-
- >prepare( them, for debugging reasons (warn $statement)
- ivan@sisd.com 98-feb-19
-
- (sigh)... use dbdef type (char, etc.) instead of a regex to
- decide what to quote in _quote (more sillines...) SQL bites.
- ivan@sisd.com 98-feb-20
-
- more friendly error messages ivan@sisd.com 98-mar-13
-
- Added import of datasrc from FS::UID to allow Pg6.3 to work
- Added code to right-trim strings read from Pg6.3 databases
- Modified 'add' to only insert fields that actually have data
- Added ut_float to handle floating point numbers (for sales
- tax). Pg6.3 does not have a "SHOW FIELDS" statement, so I
- faked it 8). bmccane@maxbaud.net 98-apr-3
-
- commented out Pg wrapper around `` Modified 'add' to only
- insert fields that actually have data '' ivan@sisd.com 98-
- apr-16
-
- dbdef usage changes ivan@sisd.com 98-jun-1
-
- sub fields now asks dbdef, not database ivan@sisd.com 98-
- jun-2
-
- added debugging method ->_dump ivan@sisd.com 98-jun-16
-
- use FS::dbdef::primary key in delete searches as well as
- replace searches (SQL still bites) ivan@sisd.com 98-jun-22
-
- sub dbdef_table ivan@sisd.com 98-jun-28
-
- removed Pg wrapper around `` Modified 'add' to only insert
- fields that actually have data '' ivan@sisd.com 98-jul-14
-
- sub fields croaks on errors ivan@sisd.com 98-jul-17
-
- $rc eq '0E0' doesn't mean we couldn't delete for all rdbmss
- ivan@sisd.com 98-jul-18
-
- commented out code to right-trim strings read from Pg6.3
- databases; ChopBlanks is in UID.pm ivan@sisd.com 98-aug-16
-
- added code (with Pg wrapper) to deal with Pg money fields
- ivan@sisd.com 98-aug-18
-
- added pod documentation ivan@sisd.com 98-sep-6
-
+++ /dev/null
-NAME
- FS::SSH - Subroutines to call ssh and scp
-
-SYNOPSIS
- use FS::SSH qw(ssh scp issh iscp sshopen2 sshopen3);
-
- ssh($host, $command);
-
- issh($host, $command);
-
- scp($source, $destination);
-
- iscp($source, $destination);
-
- sshopen2($host, $reader, $writer, $command);
-
- sshopen3($host, $reader, $writer, $error, $command);
-
-DESCRIPTION
- Simple wrappers around ssh and scp commands.
-
-SUBROUTINES
- ssh HOST, COMMAND
- Calls ssh in batch mode.
-
- issh HOST, COMMAND
- Prints the ssh command to be executed, waits for the user to
- confirm, and (optionally) executes the command.
-
- scp SOURCE, DESTINATION
- Calls scp in batch mode.
-
- iscp SOURCE, DESTINATION
- Prints the scp command to be executed, waits for the user to
- confirm, and (optionally) executes the command.
-
- sshopen2 HOST, READER, WRITER, COMMAND
- Connects the supplied filehandles to the ssh process (in
- batch mode).
-
- sshopen3 HOST, WRITER, READER, ERROR, COMMAND
- Connects the supplied filehandles to the ssh process (in
- batch mode).
-
-BUGS
- Not OO.
-
- scp stuff should transparantly use rsync-over-ssh instead.
-
-SEE ALSO
- the ssh manpage, the scp manpage, the IPC::Open2 manpage,
- the IPC::Open3 manpage
-
-HISTORY
- ivan@voicenet.com 97-jul-17
-
- added sshopen2 and sshopen3 ivan@sisd.com 98-mar-9
-
- added iscp ivan@sisd.com 98-jul-25 now iscp asks y/n, issh
- and took out path ivan@sisd.com 98-jul-30
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::UID - Subroutines for database login and assorted other
- stuff
-
-SYNOPSIS
- use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
- checkeuid checkruid swapuid);
-
- adminsuidsetup;
-
- $cgi = new CGI::Base;
- $cgi->get;
- $dbh = cgisuidsetup($cgi);
-
- $dbh = dbh;
-
- $datasrc = datasrc;
-
-DESCRIPTION
- Provides a hodgepodge of subroutines.
-
-SUBROUTINES
- adminsuidsetup
- Cleans the environment. Make sure the script is running as
- freeside, or setuid freeside. Opens a connection to the
- database. Swaps real and effective UIDs. Returns the DBI
- database handle (usually you don't need this).
-
- dbh Returns the DBI database handle.
-
- datasrc
- Returns the DBI data source.
-
- getotaker
- Returns the current Freeside user. Currently that means the
- CGI REMOTE_USER, or 'freeside'.
-
- checkeuid
- Returns true if effective UID is that of the freeside user.
-
- checkruid
- Returns true if the real UID is that of the freeside user.
-
- swapuid
- Swaps real and effective UIDs.
-
-BUGS
- Not OO.
-
- No capabilities yet. When mod_perl and Authen::DBI are
- implemented, cgisuidsetup will go away as well.
-
-SEE ALSO
- the FS::Record manpage, the CGI::Base manpage, the DBI manpage
-
-HISTORY
- ivan@voicenet.com 97-jun-4 - 9 untaint otaker ivan@voicenet.com
- 97-jul-7
-
- generalize and auto-get uid (getotaker still needs to be db'ed)
- ivan@sisd.com 97-nov-10
-
- &cgisuidsetup logs into database. other cleaning. ivan@sisd.com
- 97-nov-22,23
-
- &adminsuidsetup logs into database with otaker='freeside' (for
- automated tasks like billing) ivan@sisd.com 97-dec-13
-
- added sub datasrc for fs-setup ivan@sisd.com 98-feb-21
-
- datasrc, user and pass now come from conf/secrets ivan@sisd.com
- 98-jun-28
-
- added ChopBlanks to DBI call (see man DBI) ivan@sisd.com 98-aug-
- 16
-
- pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
- inlined suidsetup ivan@sisd.com 98-sep-12
-
+++ /dev/null
-NAME
- FS::agent - Object methods for agent records
-
-SYNOPSIS
- use FS::agent;
-
- $record = create FS::agent \%hash;
- $record = create FS::agent { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::agent object represents an agent. Every customer has an
- agent. Agents can be used to track things like resellers or
- salespeople. FS::agent inherits from FS::Record. The following
- fields are currently supported:
-
- agemtnum - primary key (assigned automatically for new agents)
- agent - Text name of this agent
- typenum - Agent type. See the FS::agent_type manpage
- prog - For future use.
- freq - For future use.
-METHODS
- create HASHREF
- Creates a new agent. To add the agent to the database, see
- the section on "insert".
-
- insert
- Adds this agent to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this agent from the database. Only agents with no
- customers can be deleted. If there is an error, returns the
- error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid agent. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
-SEE ALSO
- the FS::Record manpage, the FS::agent_type manpage, the
- FS::cust_main manpage, schema.html from the base documentation.
-
-HISTORY
- Class dealing with agent (resellers)
-
- ivan@sisd.com 97-nov-13, 97-dec-10
-
- pod, added check in ->delete ivan@sisd.com 98-sep-22
-
+++ /dev/null
-NAME
- FS::agent_type - Object methods for agent_type records
-
-SYNOPSIS
- use FS::agent_type;
-
- $record = create FS::agent_type \%hash;
- $record = create FS::agent_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::agent_type object represents an agent type. Every agent
- (see the FS::agent manpage) has an agent type. Agent types
- define which packages (see the FS::part_pkg manpage) may be
- purchased by customers (see the FS::cust_main manpage), via
- FS::type_pkgs records (see the FS::type_pkgs manpage).
- FS::agent_type inherits from FS::Record. The following fields
- are currently supported:
-
- typenum - primary key (assigned automatically for new agent types)
- atype - Text name of this agent type
-METHODS
- create HASHREF
- Creates a new agent type. To add the agent type to the
- database, see the section on "insert".
-
- insert
- Adds this agent type to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this agent type from the database. Only agent types
- with no agents can be deleted. If there is an error, returns
- the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid agent type.
- If there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
-SEE ALSO
- the FS::Record manpage, the FS::agent manpage, the FS::type_pkgs
- manpage, the FS::cust_main manpage, the FS::part_pkg manpage,
- schema.html from the base documentation.
-
-HISTORY
- Class for the different sets of allowable packages you can
- assign to an agent.
-
- ivan@sisd.com 97-nov-13
-
- ut_ FS::Record methods ivan@sisd.com 97-dec-10
-
- Changed 'type' to 'atype' because Pg6.3 reserves the type word
- bmccane@maxbaud.net 98-apr-3
-
- pod, added check in delete ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_bill - Object methods for cust_bill records
-
-SYNOPSIS
- use FS::cust_bill;
-
- $record = create FS::cust_bill \%hash;
- $record = create FS::cust_bill { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
-
- @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
-
- ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
-
- @cust_pay_objects = $cust_bill->cust_pay;
-
- @lines = $cust_bill->print_text;
- @lines = $cust_bill->print_text $time;
-
-DESCRIPTION
- An FS::cust_bill object represents an invoice. FS::cust_bill
- inherits from FS::Record. The following fields are currently
- supported:
-
- invnum - primary key (assigned automatically for new invoices)
- custnum - customer (see the FS::cust_main manpage)
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- charged - amount of this invoice
- owed - amount still outstanding on this invoice, which is charged minus
- all payments (see the FS::cust_pay manpage).
- printed - how many times this invoice has been printed automatically
- (see the section on "collect" in the FS::cust_main manpage).
-METHODS
- create HASHREF
- Creates a new invoice. To add the invoice to the database,
- see the section on "insert". Invoices are normally created
- by calling the bill method of a customer object (see the
- FS::cust_main manpage).
-
- insert
- Adds this invoice to the database ("Posts" the invoice). If
- there is an error, returns the error, otherwise returns
- false.
-
- When adding new invoices, owed must be charged (or null, in
- which case it is automatically set to charged).
-
- delete
- Currently unimplemented. I don't remove invoices because
- there would then be no record you ever posted this invoice
- (which is bad, no?)
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- Only owed and printed may be changed. Owed is normally
- updated by creating and inserting a payment (see the
- FS::cust_pay manpage). Printed is normally updated by
- calling the collect method of a customer object (see the
- FS::cust_main manpage).
-
- check
- Checks all fields to make sure this is a valid invoice. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- previous
- Returns a list consisting of the total previous balance for
- this customer, followed by the previous outstanding invoices
- (as FS::cust_bill objects also).
-
- cust_bill_pkg
- Returns the line items (see the FS::cust_bill_pkg manpage)
- for this invoice.
-
- cust_credit
- Returns a list consisting of the total previous credited
- (see the FS::cust_credit manpage) for this customer,
- followed by the previous outstanding credits
- (FS::cust_credit objects).
-
- cust_pay
- Returns all payments (see the FS::cust_pay manpage) for this
- invoice.
-
- print_text [TIME];
- Returns an ASCII invoice, as a list of lines.
-
- TIME an optional value used to control the printing of
- overdue messages. The default is now. It isn't the date of
- the invoice; that's the `_date' field. It is specified as a
- UNIX timestamp; see the section on "time" in the perlfunc
- manpage. Also see the Time::Local manpage and the
- Date::Parse manpage for conversion functions.
-
-BUGS
- The delete method.
-
- It doesn't properly override FS::Record yet.
-
- print_text formatting (and some logic :/) is in source as a
- format declaration, which needs to be slurped in from a file.
- the fork is rather kludgy as well. It could be cleaned with
- swrite from man perlform, and the picture could be put in a
- /var/spool/freeside/conf file. Also number of lines ($=).
-
- missing print_ps for a nice postscript copy (maybe HylaFAX-
- cover-page-style or something similar so the look can be
- completely customized?)
-
- There is an off-by-one error in print_text which causes a visual
- error: "Page 1 of 2" printed on some single-page invoices?
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_main manpage, the
- FS::cust_pay manpage, the FS::cust_bill_pkg manpage, the
- FS::cust_credit manpage, schema.html from the base
- documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-1
-
- small fix for new API ivan@sisd.com 98-mar-14
-
- charges can be negative ivan@sisd.com 98-jul-13
-
- pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
-
+++ /dev/null
-NAME
- FS::cust_bill_pkg - Object methods for cust_bill_pkg records
-
-SYNOPSIS
- use FS::cust_bill_pkg;
-
- $record = create FS::cust_bill_pkg \%hash;
- $record = create FS::cust_bill_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_bill_pkg object represents an invoice line item.
- FS::cust_bill_pkg inherits from FS::Record. The following fields
- are currently supported:
-
- invnum - invoice (see the FS::cust_bill manpage)
- pkgnum - package (see the FS::cust_pkg manpage)
- setup - setup fee
- recur - recurring fee
- sdate - starting date of recurring fee
- edate - ending date of recurring fee
- sdate and edate are specified as UNIX timestamps; see the
- section on "time" in the perlfunc manpage. Also see the
- Time::Local manpage and the Date::Parse manpage for conversion
- functions.
-
-METHODS
- create HASHREF
- Creates a new line item. To add the line item to the
- database, see the section on "insert". Line items are
- normally created by calling the bill method of a customer
- object (see the FS::cust_main manpage).
-
- insert
- Adds this line item to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Currently unimplemented. I don't remove line items because
- there would then be no record the items ever existed (which
- is bad, no?)
-
- replace OLD_RECORD
- Currently unimplemented. This would be even more of an
- accounting nightmare than deleteing the items. Just don't do
- it.
-
- check
- Checks all fields to make sure this is a valid line item. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert method.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_bill manpage, the
- FS::cust_pkg manpage, the FS::cust_main manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@sisd.com 98-mar-13
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_credit - Object methods for cust_credit records
-
-SYNOPSIS
- use FS::cust_credit;
-
- $record = create FS::cust_credit \%hash;
- $record = create FS::cust_credit { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_credit object represents a credit. FS::cust_credit
- inherits from FS::Record. The following fields are currently
- supported:
-
- crednum - primary key (assigned automatically for new credits)
- custnum - customer (see the FS::cust_main manpage)
- amount - amount of the credit
- credited - how much of this credit that is still outstanding, which is
- amount minus all refunds (see the FS::cust_refund manpage).
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- otaker - order taker (assigned automatically, see the FS::UID manpage)
- reason - text
-METHODS
- create HASHREF
- Creates a new credit. To add the credit to the database, see
- the section on "insert".
-
- insert
- Adds this credit to the database ("Posts" the credit). If
- there is an error, returns the error, otherwise returns
- false.
-
- When adding new invoices, credited must be amount (or null,
- in which case it is automatically set to amount).
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- Only credited may be changed. Credited is normally updated
- by creating and inserting a refund (see the FS::cust_refund
- manpage).
-
- check
- Checks all fields to make sure this is a valid credit. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- The delete method.
-
- It doesn't properly override FS::Record yet.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_refund manpage, the
- FS::cust_bill manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@sisd.com 98-mar-17
-
- pod, otaker from FS::UID ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_main - Object methods for cust_main records
-
-SYNOPSIS
- use FS::cust_main;
-
- $record = create FS::cust_main \%hash;
- $record = create FS::cust_main { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- @cust_pkg = $record->all_pkgs;
-
- @cust_pkg = $record->ncancelled_pkgs;
-
- $error = $record->bill;
- $error = $record->bill %options;
- $error = $record->bill 'time' => $time;
-
- $error = $record->collect;
- $error = $record->collect %options;
- $error = $record->collect 'invoice_time' => $time,
- 'batch_card' => 'yes',
- 'report_badcard' => 'yes',
- ;
-
-DESCRIPTION
- An FS::cust_main object represents a customer. FS::cust_main
- inherits from FS::Record. The following fields are currently
- supported:
-
- custnum - primary key (assigned automatically for new customers)
- agentnum - agent (see the FS::agent manpage)
- refnum - referral (see the FS::part_referral manpage)
- first - name
- last - name
- ss - social security number (optional)
- company - (optional)
- address1
- address2 - (optional)
- city
- county - (optional, see the FS::cust_main_county manpage)
- state - (see the FS::cust_main_county manpage)
- zip
- country - (see the FS::cust_main_county manpage)
- daytime - phone (optional)
- night - phone (optional)
- payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
- payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
- paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
- payname - name on card or billing name
- tax - tax exempt, empty or `Y'
- otaker - order taker (assigned automatically, see the FS::UID manpage)
-METHODS
- create HASHREF
- Creates a new customer. To add the customer to the database,
- see the section on "insert".
-
- Note that this stores the hash reference, not a distinct
- copy of the hash it points to. You can ask the object for a
- copy with the *hash* method.
-
- insert
- Adds this customer to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Currently unimplemented. Maybe cancel all of this customer's
- packages (cust_pkg)?
-
- I don't remove the customer record in the database because
- there would then be no record the customer ever existed
- (which is bad, no?)
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- check
- Checks all fields to make sure this is a valid customer
- record. If there is an error, returns the error, otherwise
- returns false. Called by the insert and repalce methods.
-
- all_pkgs
- Returns all packages (see the FS::cust_pkg manpage) for this
- customer.
-
- ncancelled_pkgs
- Returns all non-cancelled packages (see the FS::cust_pkg
- manpage) for this customer.
-
- bill OPTIONS
- Generates invoices (see the FS::cust_bill manpage) for this
- customer. Usually used in conjunction with the collect
- method.
-
- The only currently available option is `time', which bills
- the customer as if it were that time. It is specified as a
- UNIX timestamp; see the section on "time" in the perlfunc
- manpage). Also see the Time::Local manpage and the
- Date::Parse manpage for conversion functions.
-
- If there is an error, returns the error, otherwise returns
- false.
-
- collect OPTIONS
- (Attempt to) collect money for this customer's outstanding
- invoices (see the FS::cust_bill manpage). Usually used after
- the bill method.
-
- Depending on the value of `payby', this may print an invoice
- (`BILL'), charge a credit card (`CARD'), or just add any
- necessary (pseudo-)payment (`COMP').
-
- If there is an error, returns the error, otherwise returns
- false.
-
- Currently available options are:
-
- invoice_time - Use this time when deciding when to print
- invoices and late notices on those invoices. The default is
- now. It is specified as a UNIX timestamp; see the section on
- "time" in the perlfunc manpage). Also see the Time::Local
- manpage and the Date::Parse manpage for conversion
- functions.
-
- batch_card - Set this true to batch cards (see the
- cust_pay_batch manpage). By default, cards are processed
- immediately, which will generate an error if CyberCash is
- not installed.
-
- report_badcard - Set this true if you want bad card
- transactions to return an error. By default, they don't.
-
- total_owed
- Returns the total owed for this customer on all invoices
- (see the FS::cust_bill manpage).
-
- total_credited
- Returns the total credits (see the FS::cust_credit manpage)
- for this customer.
-
- balance
- Returns the balance for this customer (total owed minus
- total credited).
-
-BUGS
- The delete method.
-
- It doesn't properly override FS::Record yet.
-
- hfields should be removed.
-
- Bill and collect options should probably be passed as references
- instead of a list.
-
- CyberCash v2 forces us to define some variables in package main.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_pkg manpage, the
- FS::cust_bill manpage, the FS::cust_credit manpage the
- FS::cust_pay_batch manpage, the FS::agent manpage, the
- FS::part_referral manpage, the FS::cust_main_county manpage, the
- FS::UID manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-28
-
- Changed to standard Business::CreditCard no more TableUtil
- EXPORT_OK FS::Record's hfields removed unique calls and locking
- (not needed here now) wrapped the (now) optional fields in if
- statements in sub check (notyetdone!) ivan@sisd.com 97-nov-12
-
- updated paydate with SQL-type date info ivan@sisd.com 98-mar-5
-
- Added export of datasrc from UID.pm for Pg6.3 changed 'day' to
- 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
- in ->create, s/svc_acct/cust_main/, now it should actually
- eliminate the warnings it was meant to ivan@sisd.com 98-jul-16
-
- don't require a phone number and allow '/' in company names
- ivan@sisd.com 98-jul-18
-
- use ut_ and rewrite &check, &*_pkgs ivan@sisd.com 98-sep-5
-
- pod, merge with FS::Bill (about time!), total_owed,
- total_credited and balance methods, cleaned collect method,
- source modifications no longer necessary to enable cybercash,
- cybercash v3 support, don't need to import
- FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
-
+++ /dev/null
-NAME
- FS::cust_main_county - Object methods for cust_main_county
- objects
-
-SYNOPSIS
- use FS::cust_main_county;
-
- $record = create FS::cust_main_county \%hash;
- $record = create FS::cust_main_county { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_main_county object represents a tax rate, defined by
- locale. FS::cust_main_county inherits from FS::Record. The
- following fields are currently supported:
-
- taxnum - primary key (assigned automatically for new tax rates)
- state
- county
- tax - percentage
-METHODS
- create HASHREF
- Creates a new tax rate. To add the tax rate to the database,
- see the section on "insert".
-
- insert
- Adds this tax rate to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this tax rate from the database. If there is an
- error, returns the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- check
- Checks all fields to make sure this is a valid tax rate. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- A country field (and possibly a currency field) should be added.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_main manpage, the
- FS::cust_bill manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-dec-16
-
- Changed check for 'tax' to use the new ut_float subroutine
- bmccane@maxbaud.net 98-apr-3
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_pay - Object methods for cust_pay objects
-
-SYNOPSIS
- use FS::cust_pay;
-
- $record = create FS::cust_pay \%hash;
- $record = create FS::cust_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_pay object represents a payment. FS::cust_pay
- inherits from FS::Record. The following fields are currently
- supported:
-
- paynum - primary key (assigned automatically for new payments)
- invnum - Invoice (see the FS::cust_bill manpage)
- paid - Amount of this payment
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
- payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
- paybatch - text field for tracking card processing
-METHODS
- create HASHREF
- Creates a new payment. To add the payment to the databse,
- see the section on "insert".
-
- insert
- Adds this payment to the databse, and updates the invoice
- (see the FS::cust_bill manpage).
-
- delete
- Currently unimplemented (accounting reasons).
-
- replace OLD_RECORD
- Currently unimplemented (accounting reasons).
-
- check
- Checks all fields to make sure this is a valid payment. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert method.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- Delete and replace methods.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_bill manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-1 - 25 - 29
-
- new api ivan@sisd.com 98-mar-13
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_pkg - Object methods for cust_pkg objects
-
-SYNOPSIS
- use FS::cust_pkg;
-
- $record = create FS::cust_pkg \%hash;
- $record = create FS::cust_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->cancel;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = FS::cust_pkg::order( $custnum, \@pkgparts );
- $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
-
-DESCRIPTION
- An FS::cust_pkg object represents a customer billing item.
- FS::cust_pkg inherits from FS::Record. The following fields are
- currently supported:
-
- pkgnum - primary key (assigned automatically for new billing items)
- custnum - Customer (see the FS::cust_main manpage)
- pkgpart - Billing item definition (see the FS::part_pkg manpage)
- setup - date
- bill - date
- susp - date
- expire - date
- cancel - date
- otaker - order taker (assigned automatically if null, see the FS::UID manpage)
- Note: setup, bill, susp, expire and cancel are specified as UNIX
- timestamps; see the section on "time" in the perlfunc manpage.
- Also see the Time::Local manpage and the Date::Parse manpage for
- conversion functions.
-
-METHODS
- create HASHREF
- Create a new billing item. To add the item to the database,
- see the section on "insert".
-
- insert
- Adds this billing item to the database ("Orders" the item).
- If there is an error, returns the error, otherwise returns
- false.
-
- delete
- Currently unimplemented. You don't want to delete billing
- items, because there would then be no record the customer
- ever purchased the item. Instead, see the cancel method.
-
- sub delete { return "Can't delete cust_pkg records!"; }
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- Currently, custnum, setup, bill, susp, expire, and cancel
- may be changed.
-
- pkgpart may not be changed, but see the order subroutine.
-
- setup and bill are normally updated by calling the bill
- method of a customer object (see the FS::cust_main manpage).
-
- suspend is normally updated by the suspend and unsuspend
- methods.
-
- cancel is normally updated by the cancel method (and also
- the order subroutine in some cases).
-
- check
- Checks all fields to make sure this is a valid billing item.
- If there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- cancel
- Cancels and removes all services (see the FS::cust_svc
- manpage and the FS::part_svc manpage) in this package, then
- cancels the package itself (sets the cancel field to now).
-
- If there is an error, returns the error, otherwise returns
- false.
-
- suspend
- Suspends all services (see the FS::cust_svc manpage and the
- FS::part_svc manpage) in this package, then suspends the
- package itself (sets the susp field to now).
-
- If there is an error, returns the error, otherwise returns
- false.
-
- unsuspend
- Unsuspends all services (see the FS::cust_svc manpage and
- the FS::part_svc manpage) in this package, then unsuspends
- the package itself (clears the susp field).
-
- If there is an error, returns the error, otherwise returns
- false.
-
-SUBROUTINES
- order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
- CUSTNUM is a customer (see the FS::cust_main manpage)
-
- PKGPARTS is a list of pkgparts specifying the the billing
- item definitions (see the FS::part_pkg manpage) to order for
- this customer. Duplicates are of course permitted.
-
- REMOVE_PKGNUMS is an optional list of pkgnums specifying the
- billing items to remove for this customer. The services (see
- the FS::cust_svc manpage) are moved to the new billing
- items. An error is returned if this is not possible (see the
- FS::pkg_svc manpage).
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- sub order is not OO. Perhaps it should be moved to FS::cust_main
- and made so?
-
- In sub order, the @pkgparts array (passed by reference) is
- clobbered.
-
- Also in sub order, no money is adjusted. Once FS::part_pkg
- defines a standard method to pass dates to the recur_prog
- expression, it should do so.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_main manpage, the
- FS::part_pkg manpage, the FS::cust_svc manpage , the FS::pkg_svc
- manpage, schema.html from the base documentation
-
-HISTORY
- ivan@voicenet.com 97-jul-1 - 21
-
- fixed for new agent->agent_type->type_pkgs in &order
- ivan@sisd.com 98-mar-7
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_refund - Object method for cust_refund objects
-
-SYNOPSIS
- use FS::cust_refund;
-
- $record = create FS::cust_refund \%hash;
- $record = create FS::cust_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_refund represents a refund. FS::cust_refund inherits
- from FS::Record. The following fields are currently supported:
-
- refundnum - primary key (assigned automatically for new refunds)
- crednum - Credit (see the FS::cust_credit manpage)
- refund - Amount of the refund
- _date - specified as a UNIX timestamp; see the section on "time" in the perlfunc manpage. Also see
- the Time::Local manpage and the Date::Parse manpage for conversion functions.
- payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
- payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
- otaker - order taker (assigned automatically, see the FS::UID manpage)
-METHODS
- create HASHREF
- Creates a new refund. To add the refund to the database, see
- the section on "insert".
-
- insert
- Adds this refund to the database, and updates the credit
- (see the FS::cust_credit manpage).
-
- delete
- Currently unimplemented (accounting reasons).
-
- replace OLD_RECORD
- Currently unimplemented (accounting reasons).
-
- check
- Checks all fields to make sure this is a valid refund. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert method.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- Delete and replace methods.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_credit manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@sisd.com 98-mar-18
-
- ->create had wrong tablename ivan@sisd.com 98-jun-16 (finish
- me!)
-
- pod and finish up ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::cust_svc - Object method for cust_svc objects
-
-SYNOPSIS
- use FS::cust_svc;
-
- $record = create FS::cust_svc \%hash
- $record = create FS::cust_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::cust_svc represents a service. FS::cust_svc inherits from
- FS::Record. The following fields are currently supported:
-
- svcnum - primary key (assigned automatically for new services)
- pkgnum - Package (see the FS::cust_pkg manpage)
- svcpart - Service definition (see the FS::part_svc manpage)
-METHODS
- create HASHREF
- Creates a new service. To add the refund to the database,
- see the section on "insert". Services are normally created
- by creating FS::svc_ objects (see the FS::svc_acct manpage,
- the FS::svc_domain manpage, and the FS::svc_acct_sm manpage,
- among others).
-
- insert
- Adds this service to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this service from the database. If there is an
- error, returns the error, otherwise returns false.
-
- Called by the cancel method of the package (see the
- FS::cust_pkg manpage).
-
- replace OLD_RECORD
- Replaces the OLD_RECORD with this one in the database. If
- there is an error, returns the error, otherwise returns
- false.
-
- check
- Checks all fields to make sure this is a valid service. If
- there is an error, returns the error, otehrwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- Behaviour of changing the svcpart of cust_svc records is
- undefined and should possibly be prohibited, and pkg_svc records
- are not checked.
-
- pkg_svc records are not checket in general (here).
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_pkg manpage, the
- FS::part_svc manpage, the FS::pkg_svc manpage, schema.html from
- the base documentation
-
-HISTORY
- ivan@voicenet.com 97-jul-10,14
-
- no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::dbdef - Database objects
-
-SYNOPSIS
- use FS::dbdef;
-
- $dbdef = new FS::dbdef (@dbdef_table_objects);
- $dbdef = load FS::dbdef "filename";
-
- $dbdef->save("filename");
-
- $dbdef->addtable($dbdef_table_object);
-
- @table_names = $dbdef->tables;
-
- $FS_dbdef_table_object = $dbdef->table;
-
-DESCRIPTION
- FS::dbdef objects are collections of FS::dbdef_table objects and
- represnt a database (a collection of tables).
-
-METHODS
- new TABLE, TABLE, ...
- Creates a new FS::dbdef object
-
- load FILENAME
- Loads an FS::dbdef object from a file.
-
- save FILENAME
- Saves an FS::dbdef object to a file.
-
- addtable TABLE
- Adds this FS::dbdef_table object.
-
- tables
- Returns the names of all tables.
-
- table TABLENAME
- Returns the named FS::dbdef_table object.
-
-BUGS
- Each FS::dbdef object should have a name which corresponds
- to its name within the SQL database engine.
-
-SEE ALSO
- the FS::dbdef_table manpage, the FS::Record manpage,
-
-HISTORY
- beginning of abstraction into a class (not really)
-
- ivan@sisd.com 97-dec-4
-
- added primary_key ivan@sisd.com 98-jan-20
-
- added datatype (very kludgy and needs to be cleaned)
- ivan@sisd.com 98-feb-21
-
- perltrap (sigh) masked by mysql 3.20->3,21 ivan@sisd.com 98-
- mar-2
-
- Change 'type' to 'atype' in agent_type Changed attributes to
- special words which are changed in fs-setup ie. double(10,2)
- <=> MONEYTYPE Changed order of some of the field definitions
- because Pg6.3 is picky Changed 'day' to 'daytime' in
- cust_main Changed type of tax from tinyint to real Change
- 'password' to '_password' in svc_acct Pg6.3 does not allow
- 'field char(x) NULL' bmccane@maxbaud.net 98-apr-3
-
- rewrite: now properly OO. See also
- FS::dbdef_{table,column,unique,index}
-
- ivan@sisd.com 98-apr-17
-
- gained some extra functions ivan@sisd.com 98-may-11
-
- now knows how to Freeze and Thaw itself ivan@sisd.com 98-
- jun-2
-
- pod ivan@sisd.com 98-sep-23
-
+++ /dev/null
-NAME
- FS::dbdef_colgroup - Column group objects
-
-SYNOPSIS
- use FS::dbdef_colgroup;
-
- $colgroup = new FS::dbdef_colgroup ( $lol );
- $colgroup = new FS::dbdef_colgroup (
- [
- [ 'single_column' ],
- [ 'multiple_columns', 'another_column', ],
- ]
- );
-
- @sql_lists = $colgroup->sql_list;
-
- @singles = $colgroup->singles;
-
-DESCRIPTION
- FS::dbdef_colgroup objects represent sets of sets of columns.
-
-METHODS
- new Creates a new FS::dbdef_colgroup object.
-
- sql_list
- Returns a flat list of comma-separated values, for SQL
- statements.
-
- singles
- Returns a flat list of all single item lists.
-
-BUGS
-SEE ALSO
- the FS::dbdef_table manpage, the FS::dbdef_unique manpage, the
- FS::dbdef_index manpage, the FS::dbdef_column manpage, the
- FS::dbdef manpage, the perldsc manpage
-
-HISTORY
- class for dealing with groups of groups of columns (used as a
- base class by FS::dbdef_{unique,index} )
-
- ivan@sisd.com 98-apr-19
-
- added singles, fixed sql_list to skip empty lists ivan@sisd.com
- 98-jun-2
-
- untaint things we're returning in sub singels ivan@sisd.com 98-
- jun-4
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-NAME
- FS::dbdef_column - Column object
-
-SYNOPSIS
- use FS::dbdef_column;
-
- $column_object = new FS::dbdef_column ( $name, $sql_type, '' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, '', $length );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL', $length );
-
- $name = $column_object->name;
- $column_object->name ( 'name' );
-
- $name = $column_object->type;
- $column_object->name ( 'sql_type' );
-
- $name = $column_object->null;
- $column_object->name ( 'NOT NULL' );
-
- $name = $column_object->length;
- $column_object->name ( $length );
-
- $sql_line = $column->line;
- $sql_line = $column->line $datasrc;
-
-DESCRIPTION
- FS::dbdef::column objects represend columns in tables (see the
- FS::dbdef_table manpage).
-
-METHODS
- new Creates a new FS::dbdef_column object.
-
- name
- Returns or sets the column name.
-
- type
- Returns or sets the column type.
-
- null
- Returns or sets the column null flag.
-
- type
- Returns or sets the column length.
-
- line [ $datasrc ]
- Returns an SQL column definition.
-
- If passed a DBI $datasrc specifying the DBD::mysql manpage,
- will use MySQL-specific syntax. Non-standard syntax for
- other engines (if applicable) may also be supported in the
- future.
-
-BUGS
-SEE ALSO
- the FS::dbdef_table manpage, the FS::dbdef manpage, the DBI
- manpage
-
-HISTORY
- class for dealing with column definitions
-
- ivan@sisd.com 98-apr-17
-
- now methods can be used to get or set data ivan@sisd.com 98-may-
- 11
-
- mySQL-specific hack for null (what should be default?)
- ivan@sisd.com 98-jun-2
-
+++ /dev/null
-NAME
- FS::dbdef_unique.pm - Index object
-
-SYNOPSIS
- use FS::dbdef_index;
-
- # see FS::dbdef_colgroup methods
-
-DESCRIPTION
- FS::dbdef_unique objects represent the (non-unique) indices of a
- table (the FS::dbdef_table manpage). FS::dbdef_unique inherits
- from FS::dbdef_colgroup.
-
-BUGS
- Is this empty subclass needed?
-
-SEE ALSO
- the FS::dbdef_colgroup manpage, the FS::dbdef_record manpage,
- the FS::Record manpage
-
-HISTORY
- class for dealing with index definitions
-
- ivan@sisd.com 98-apr-19
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-NAME
- FS::dbdef_table - Table objects
-
-SYNOPSIS
- use FS::dbdef_table;
-
- $dbdef_table = new FS::dbdef_table (
- "table_name",
- "primary_key",
- $FS_dbdef_unique_object,
- $FS_dbdef_index_object,
- @FS_dbdef_column_objects,
- );
-
- $dbdef_table->addcolumn ( $FS_dbdef_column_object );
-
- $table_name = $dbdef_table->name;
- $dbdef_table->name ("table_name");
-
- $table_name = $dbdef_table->primary_keye;
- $dbdef_table->primary_key ("primary_key");
-
- $FS_dbdef_unique_object = $dbdef_table->unique;
- $dbdef_table->unique ( $FS_dbdef_unique_object );
-
- $FS_dbdef_index_object = $dbdef_table->index;
- $dbdef_table->index ( $FS_dbdef_index_object );
-
- @column_names = $dbdef->columns;
-
- $FS_dbdef_column_object = $dbdef->column;
-
- @sql_statements = $dbdef->sql_create_table;
- @sql_statements = $dbdef->sql_create_table $datasrc;
-
-DESCRIPTION
- FS::dbdef_table objects represent a single database table.
-
-METHODS
- new Creates a new FS::dbdef_table object.
-
- addcolumn
- Adds this FS::dbdef_column object.
-
- name
- Returns or sets the table name.
-
- primary_key
- Returns or sets the primary key.
-
- unique
- Returns or sets the FS::dbdef_unique object.
-
- index
- Returns or sets the FS::dbdef_index object.
-
- columns
- Returns a list consisting of the names of all columns.
-
- column "column"
- Returns the column object (see the FS::dbdef_column manpage)
- for "column".
-
- sql_create_table [ $datasrc ]
- Returns an array of SQL statments to create this table.
-
- If passed a DBI $datasrc specifying the DBD::mysql manpage,
- will use MySQL-specific syntax. Non-standard syntax for
- other engines (if applicable) may also be supported in the
- future.
-
-BUGS
-SEE ALSO
- the FS::dbdef manpage, the FS::dbdef_unique manpage, the
- FS::dbdef_index manpage, the FS::dbdef_unique manpage, the DBI
- manpage
-
-HISTORY
- class for dealing with table definitions
-
- ivan@sisd.com 98-apr-18
-
- gained extra functions (should %columns be an IxHash?)
- ivan@sisd.com 98-may-11
-
- sql_create_table returns a list of statments, not just one, and
- now it does indices (plus mysql hack) ivan@sisd.com 98-jun-2
-
- untaint primary_key... hmm. is this a hack around a bigger
- problem? looks like, did the same thing singles in colgroup!
- ivan@sisd.com 98-jun-4
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-NAME
- FS::dbdef_unique.pm - Unique object
-
-SYNOPSIS
- use FS::dbdef_unique;
-
- # see FS::dbdef_colgroup methods
-
-DESCRIPTION
- FS::dbdef_unique objects represent the unique indices of a
- database table (the FS::dbdef_table manpage). FS::dbdef_unique
- inherits from FS::dbdef_colgroup.
-
-BUGS
- Is this empty subclass needed?
-
-SEE ALSO
- the FS::dbdef_colgroup manpage, the FS::dbdef_record manpage,
- the FS::Record manpage
-
-HISTORY
- class for dealing with unique definitions
-
- ivan@sisd.com 98-apr-19
-
- pod ivan@sisd.com 98-sep-24
-
+++ /dev/null
-<head>
- <title>Perl API</title>
-</head>
-<body>
- <h1>Perl API</h1>
- <ul>
-<li><a href="agent.txt">FS::agent</a>
-<li><a href="agent_type.txt">FS::agent_type</a>
-<li><a href="cust_bill.txt">FS::cust_bill</a>
-<li><a href="cust_bill_pkg.txt">FS::cust_bill_pkg</a>
-<li><a href="cust_credit.txt">FS::cust_credit</a>
-<li><a href="cust_main.txt">FS::cust_main</a>
-<li><a href="cust_main_county.txt">FS::cust_main_county</a>
-<li><a href="cust_pay.txt">FS::cust_pay</a>
-<li><a href="cust_pkg.txt">FS::cust_pkg</a>
-<li><a href="cust_refund.txt">FS::cust_refund</a>
-<li><a href="cust_svc.txt">FS::cust_svc</a>
-<li><a href="part_pkg.txt">FS::part_pkg</a>
-<li><a href="part_referral.txt">FS::part_referral</a>
-<li><a href="part_svc.txt">FS::part_svc</a>
-<li><a href="pkg_svc.txt">FS::pkg_svc</a>
-<li><a href="svc_acct.txt">FS::svc_acct</a>
-<li><a href="svc_acct_pop.txt">FS::svc_acct_pop</a>
-<li><a href="svc_acct_sm.txt">FS::svc_acct_sm</a>
-<li><a href="svc_domain.txt">FS::svc_domain</a>
-<li><a href="type_pkgs.txt">FS::type_pkgs</a>
-</ul>
-<br>
-<ul>
-<li><a href="Bill.txt">FS::Bill</a>
-<li><a href="CGI.txt">FS::CGI</a>
-<li><a href="Conf.txt">FS::Conf</a>
-<li><a href="Invoice.txt">FS::Invoice</a>
-<li><a href="Record.txt">FS::Record</a>
-<li><a href="SSH.txt">FS::SSH</a>
-<li><a href="UID.txt">FS::UID</a>
-</ul>
-<br>
-<ul>
-<li><a href="dbdef.txt">FS::dbdef</a>
-<li><a href="dbdef_colgroup.txt">FS::dbdef_colgroup</a>
-<li><a href="dbdef_column.txt">FS::dbdef_column</a>
-<li><a href="dbdef_index.txt">FS::dbdef_index</a>
-<li><a href="dbdef_table.txt">FS::dbdef_table</a>
-<li><a href="dbdef_unique.txt">FS::dbdef_unique</a>
-
-<ul>
-</body>
+++ /dev/null
-NAME
- FS::part_pkg - Object methods for part_pkg objects
-
-SYNOPSIS
- use FS::part_pkg;
-
- $record = create FS::part_pkg \%hash
- $record = create FS::part_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::part_pkg represents a billing item definition.
- FS::part_pkg inherits from FS::Record. The following fields are
- currently supported:
-
- pkgpart - primary key (assigned automatically for new billing item definitions)
- pkg - Text name of this billing item definition (customer-viewable)
- comment - Text name of this billing item definition (non-customer-viewable)
- setup - Setup fee
- freq - Frequency of recurring fee
- recur - Recurring fee
- setup and recur are evaluated as Safe perl expressions. You can
- use numbers just as you would normally. More advanced semantics
- are not yet defined.
-
-METHODS
- create HASHREF
- Creates a new billing item definition. To add the billing
- item definition to the database, see the section on
- "insert".
-
- insert
- Adds this billing item definition to the database. If there
- is an error, returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid billing item
- definition. If there is an error, returns the error,
- otherwise returns false. Called by the insert and replace
- methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- The delete method is unimplemented.
-
- setup and recur semantics are not yet defined (and are
- implemented in FS::cust_bill. hmm.).
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_pkg manpage, the
- FS::type_pkgs manpage, the FS::pkg_svc manpage, the Safe
- manpage. schema.html from the base documentation.
-
-HISTORY
- ivan@sisd.com 97-dec-5
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::part_referral - Object methods for part_referral objects
-
-SYNOPSIS
- use FS::part_referral;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::part_referral represents a referral - where a customer
- heard of your services. This can be used to track the
- effectiveness of a particular piece of advertising, for example.
- FS::part_referral inherits from FS::Record. The following fields
- are currently supported:
-
- refnum - primary key (assigned automatically for new referrals)
- referral - Text name of this referral
-METHODS
- create HASHREF
- Creates a new referral. To add the referral to the database,
- see the section on "insert".
-
- insert
- Adds this referral to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid referral. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- The delete method is unimplemented.
-
-SEE ALSO
- the FS::Record manpage, the FS::cust_main manpage, schema.html
- from the base documentation.
-
-HISTORY
- Class dealing with referrals
-
- ivan@sisd.com 98-feb-23
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::part_svc - Object methods for part_svc objects
-
-SYNOPSIS
- use FS::part_svc;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::part_svc represents a service definition. FS::part_svc
- inherits from FS::Record. The following fields are currently
- supported:
-
- svcpart - primary key (assigned automatically for new service definitions)
- svc - text name of this service definition
- svcdb - table used for this service. See the FS::svc_acct manpage,
- the FS::svc_domain manpage, and the FS::svc_acct_sm manpage, among others.
- *svcdb*__*field* - Default or fixed value for *field* in *svcdb*.
- *svcdb*__*field*_flag - defines *svcdb*__*field* action: null, `D' for default, or `F' for fixed
-METHODS
- create HASHREF
- Creates a new service definition. To add the service
- definition to the database, see the section on "insert".
-
- insert
- Adds this service definition to the database. If there is an
- error, returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid service
- definition. If there is an error, returns the error,
- otherwise returns false. Called by the insert and replace
- methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- Delete is unimplemented.
-
-SEE ALSO
- the FS::Record manpage, the FS::part_pkg manpage, the
- FS::pkg_svc manpage, the FS::cust_svc manpage, the FS::svc_acct
- manpage, the FS::svc_acct_sm manpage, the FS::svc_domain
- manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@sisd.com 97-nov-14
-
- data checking/untainting calls into FS::Record added
- ivan@sisd.com 97-dec-6
-
- pod ivan@sisd.com 98-sep-21
-
+++ /dev/null
-NAME
- FS::pkg_svc - Object methods for pkg_svc records
-
-SYNOPSIS
- use FS::pkg_svc;
-
- $record = create FS::pkg_svc \%hash;
- $record = create FS::pkg_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::pkg_svc record links a billing item definition (see the
- FS::part_pkg manpage) to a service definition (see the
- FS::part_svc manpage). FS::pkg_svc inherits from FS::Record. The
- following fields are currently supported:
-
- pkgpart - Billing item definition (see the FS::part_pkg manpage)
- svcpart - Service definition (see the FS::part_svc manpage)
- quantity - Quantity of this service definition that this billing item
- definition includes
-METHODS
- create HASHREF
- Create a new record. To add the record to the database, see
- the section on "insert".
-
- insert
- Adds this record to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this record from the database. If there is an error,
- returns the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid record. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
-SEE ALSO
- the FS::Record manpage, the FS::part_pkg manpage, the
- FS::part_svc manpage, schema.html from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-1 added hfields ivan@sisd.com 97-nov-13
-
- pod ivan@sisd.com 98-sep-22
-
+++ /dev/null
-NAME
- FS::svc_acct - Object methods for svc_acct records
-
-SYNOPSIS
- use FS::svc_acct;
-
- $record = create FS::svc_acct \%hash;
- $record = create FS::svc_acct { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-DESCRIPTION
- An FS::svc_acct object represents an account. FS::svc_acct
- inherits from FS::Record. The following fields are currently
- supported:
-
- svcnum - primary key (assigned automatcially for new accounts)
- username
- _password - generated if blank
- popnum - Point of presence (see the FS::svc_acct_pop manpage)
- uid
- gid
- finger - GECOS
- dir - set automatically if blank (and uid is not)
- shell
- quota - (unimplementd)
- slipip - IP address
- radius_*Radius_Attribute* - *Radius-Attribute*
-METHODS
- create HASHREF
- Creates a new account. To add the account to the database,
- see the section on "insert".
-
- insert
- Adds this account to the database. If there is an error,
- returns the error, otherwise returns false.
-
- The additional fields pkgnum and svcpart (see the
- FS::cust_svc manpage) should be defined. An FS::cust_svc
- record will be created and inserted.
-
- If the configuration value (see the FS::Conf manpage)
- shellmachine exists, and the username, uid, and dir fields
- are defined, the command
-
- useradd -d $dir -m -s $shell -u $uid $username
-
- is executed on shellmachine via ssh. This behaviour can be
- surpressed by setting $FS::svc_acct::nossh_hack true.
-
- delete
- Deletes this account from the database. If there is an
- error, returns the error, otherwise returns false.
-
- The corresponding FS::cust_svc record will be deleted as
- well.
-
- If the configuration value (see the FS::Conf manpage)
- shellmachine exists, the command:
-
- userdel $username
-
- is executed on shellmachine via ssh. This behaviour can be
- surpressed by setting $FS::svc_acct::nossh_hack true.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- If the configuration value (see the FS::Conf manpage)
- shellmachine exists, and the dir field has changed, the
- command:
-
- [ -d $old_dir ] && (
- chmod u+t $old_dir;
- umask 022;
- mkdir $new_dir;
- cd $old_dir;
- find . -depth -print | cpio -pdm $new_dir;
- chmod u-t $new_dir;
- chown -R $uid.$gid $new_dir;
- rm -rf $old_dir
- )
-
- is executed on shellmachine via ssh. This behaviour can be
- surpressed by setting $FS::svc_acct::nossh_hack true.
-
- suspend
- Suspends this account by prefixing *SUSPENDED* to the
- password. If there is an error, returns the error, otherwise
- returns false.
-
- Called by the suspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- unsuspend
- Unsuspends this account by removing *SUSPENDED* from the
- password. If there is an error, returns the error, otherwise
- returns false.
-
- Called by the unsuspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- cancel
- Just returns false (no error) for now.
-
- Called by the cancel method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- check
- Checks all fields to make sure this is a valid service. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- Sets any fixed values; see the FS::part_svc manpage.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- The remote commands should be configurable.
-
- The create method should set defaults from part_svc (like the
- check method sets fixed values).
-
-SEE ALSO
- the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc
- manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the
- FS::SSH manpage, the ssh manpage, the FS::svc_acct_pop manpage,
- schema.html from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-16 - 21
-
- rewrite (among other things, now know about part_svc)
- ivan@sisd.com 98-mar-8
-
- Changed 'password' to '_password' because Pg6.3 reserves the
- password word bmccane@maxbaud.net 98-apr-3
-
- username length and shell no longer hardcoded ivan@sisd.com 98-
- jun-28
-
- eww but needed: ignore uid duplicates for 'fax' and 'hylafax'
- ivan@sisd.com 98-jun-29
-
- $nossh_hack ivan@sisd.com 98-jul-13
-
- protections against UID/GID of 0 for incorrectly-setup RDBMSs
- (also in bin/svc_acct.export) ivan@sisd.com 98-jul-13
-
- arbitrary radius attributes ivan@sisd.com 98-aug-13
-
- /var/spool/freeside/conf/shellmachine ivan@sisd.com 98-aug-13
-
- pod and FS::conf ivan@sisd.com 98-sep-22
-
+++ /dev/null
-NAME
- FS::svc_acct_pop - Object methods for svc_acct_pop records
-
-SYNOPSIS
- use FS::svc_acct_pop;
-
- $record = create FS::svc_acct_pop \%hash;
- $record = create FS::svc_acct_pop { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::svc_acct object represents an point of presence.
- FS::svc_acct_pop inherits from FS::Record. The following fields
- are currently supported:
-
- popnum - primary key (assigned automatically for new accounts)
- city
- state
- ac - area code
- exch - exchange
-METHODS
- create HASHREF
- Creates a new point of presence (if only it were that
- easy!). To add the point of presence to the database, see
- the section on "insert".
-
- insert
- Adds this point of presence to the databaes. If there is an
- error, returns the error, otherwise returns false.
-
- delete
- Currently unimplemented.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid point of
- presence. If there is an error, returns the error, otherwise
- returns false. Called by the insert and replace methods.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- It should be renamed to part_pop.
-
-SEE ALSO
- the FS::Record manpage, the svc_acct manpage, schema.html from
- the base documentation.
-
-HISTORY
- Class dealing with pops
-
- ivan@sisd.com 98-mar-8
-
- pod ivan@sisd.com 98-sep-23
-
+++ /dev/null
-NAME
- FS::svc_acct_sm - Object methods for svc_acct_sm records
-
-SYNOPSIS
- use FS::svc_acct_sm;
-
- $record = create FS::svc_acct_sm \%hash;
- $record = create FS::svc_acct_sm { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-DESCRIPTION
- An FS::svc_acct object represents a virtual mail alias.
- FS::svc_acct inherits from FS::Record. The following fields are
- currently supported:
-
- svcnum - primary key (assigned automatcially for new accounts)
- domsvc - svcnum of the virtual domain (see the FS::svc_domain manpage)
- domuid - uid of the target account (see the FS::svc_acct manpage)
- domuser - virtual username
-METHODS
- create HASHREF
- Creates a new virtual mail alias. To add the virtual mail
- alias to the database, see the section on "insert".
-
- insert
- Adds this virtual mail alias to the database. If there is an
- error, returns the error, otherwise returns false.
-
- The additional fields pkgnum and svcpart (see the
- FS::cust_svc manpage) should be defined. An FS::cust_svc
- record will be created and inserted.
-
- If the configuration values (see the FS::Conf manpage)
- shellmachine and qmailmachines exist, and domuser is `*'
- (meaning a catch-all mailbox), the command:
-
- [ -e $dir/.qmail-$qdomain-default ] || {
- touch $dir/.qmail-$qdomain-default;
- chown $uid:$gid $dir/.qmail-$qdomain-default;
- }
-
- is executed on shellmachine via ssh (see the section on
- "EXTENSION ADDRESSES" in the dot-qmail manpage). This
- behaviour can be surpressed by setting
- $FS::svc_acct_sm::nossh_hack true.
-
- delete
- Deletes this virtual mail alias from the database. If there
- is an error, returns the error, otherwise returns false.
-
- The corresponding FS::cust_svc record will be deleted as
- well.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- suspend
- Just returns false (no error) for now.
-
- Called by the suspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- unsuspend
- Just returns false (no error) for now.
-
- Called by the unsuspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- cancel
- Just returns false (no error) for now.
-
- Called by the cancel method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- check
- Checks all fields to make sure this is a valid virtual mail
- alias. If there is an error, returns the error, otherwise
- returns false. Called by the insert and replace methods.
-
- Sets any fixed values; see the FS::part_svc manpage.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- The remote commands should be configurable.
-
-SEE ALSO
- the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc
- manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the
- FS::svc_acct manpage, the FS::svc_domain manpage, the FS::SSH
- manpage, the ssh manpage, the dot-qmail manpage, schema.html
- from the base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-16 - 21
-
- rewrite ivan@sisd.com 98-mar-10
-
- s/qsearchs/qsearch/ to eliminate warning ivan@sisd.com 98-apr-19
-
- uses conf/shellmachine and has an nossh_hack ivan@sisd.com 98-
- jul-14
-
- s/\./:/g in .qmail-domain:com ivan@sisd.com 98-aug-13
-
- pod, FS::Conf, moved .qmail file from check to insert 98-sep-23
-
+++ /dev/null
-NAME
- FS::svc_domain - Object methods for svc_domain records
-
-SYNOPSIS
- use FS::svc_domain;
-
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-DESCRIPTION
- An FS::svc_domain object represents a domain. FS::svc_domain
- inherits from FS::Record. The following fields are currently
- supported:
-
- svcnum - primary key (assigned automatically for new accounts)
- domain
-METHODS
- create HASHREF
- Creates a new domain. To add the domain to the database, see
- the section on "insert".
-
- insert
- Adds this domain to the database. If there is an error,
- returns the error, otherwise returns false.
-
- The additional fields *pkgnum* and *svcpart* (see the
- FS::cust_svc manpage) should be defined. An FS::cust_svc
- record will be created and inserted.
-
- The additional field *action* should be set to *N* for new
- domains or *M* for transfers.
-
- A registration or transfer email will be submitted unless
- $FS::svc_domain::whois_hack is true.
-
- delete
- Deletes this domain from the database. If there is an error,
- returns the error, otherwise returns false.
-
- The corresponding FS::cust_svc record will be deleted as
- well.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- suspend
- Just returns false (no error) for now.
-
- Called by the suspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- unsuspend
- Just returns false (no error) for now.
-
- Called by the unsuspend method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- cancel
- Just returns false (no error) for now.
-
- Called by the cancel method of FS::cust_pkg (see the
- FS::cust_pkg manpage).
-
- check
- Checks all fields to make sure this is a valid domain. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
- Sets any fixed values; see the FS::part_svc manpage.
-
- _whois
- Executes the command:
-
- whois do $domain
-
- and returns the output.
-
- (Always returns *No match for domian "$domain".* if
- $FS::svc_domain::whois_hack is set true.)
-
- submit_internic
- Submits a registration email for this domain.
-
-BUGS
- It doesn't properly override FS::Record yet.
-
- All BIND/DNS fields should be included (and exported).
-
- All registries should be supported.
-
- Not all configuration access is through FS::Conf!
-
- Should change action to a real field.
-
-SEE ALSO
- the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc
- manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, the
- FS::SSH manpage, the ssh manpage, the dot-qmail manpage,
- schema.html from the base documentation, config.html from the
- base documentation.
-
-HISTORY
- ivan@voicenet.com 97-jul-21
-
- rewrite ivan@sisd.com 98-mar-10
-
- add internic bits ivan@sisd.com 98-mar-14
-
- Changed 'day' to 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
- /var/spool/freeside/conf/registries/internic/, Mail::Internet,
- etc. ivan@sisd.com 98-jul-17-19
-
- pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
-
+++ /dev/null
-NAME
- FS::type_pkgs - Object methods for type_pkgs records
-
-SYNOPSIS
- use FS::type_pkgs;
-
- $record = create FS::type_pkgs \%hash;
- $record = create FS::type_pkgs { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-DESCRIPTION
- An FS::type_pkgs record links an agent type (see the
- FS::agent_type manpage) to a billing item definition (see the
- FS::part_pkg manpage). FS::type_pkgs inherits from FS::Record.
- The following fields are currently supported:
-
- typenum - Agent type, see the FS::agent_type manpage
- pkgpart - Billing item definition, see the FS::part_pkg manpage
-METHODS
- create HASHREF
- Create a new record. To add the record to the database, see
- the section on "insert".
-
- insert
- Adds this record to the database. If there is an error,
- returns the error, otherwise returns false.
-
- delete
- Deletes this record from the database. If there is an error,
- returns the error, otherwise returns false.
-
- replace OLD_RECORD
- Replaces OLD_RECORD with this one in the database. If there
- is an error, returns the error, otherwise returns false.
-
- check
- Checks all fields to make sure this is a valid record. If
- there is an error, returns the error, otherwise returns
- false. Called by the insert and replace methods.
-
-HISTORY
- Defines the relation between agent types and pkgparts (Which
- pkgparts can the different [types of] agents sell?)
-
- ivan@sisd.com 97-nov-13
-
- change to ut_ FS::Record, fixed bugs ivan@sisd.com 97-dec-10
-
+++ /dev/null
-<head>
- <title>fs_passwd</title>
-</head>
-<body>
- <h1>fs_passwd</h1>
-You may use fs_passwd/fs_passwd as a "passwd", "chfn" and "chsh" replacement on your shell machine(s) to cause password, gecos and shell changes to update your freeside machine. This can pose a security risk if not configured correctly. <b>Do not use this feature unless you understand what you are doing!</b>
-<br><br>Currently it is assumed that the the crypt(3) function in the C library is the same on the Freeside machine as on the target machine.
-<ul>
- <li>Create a freeside account on the shell machine(s).
- <li>Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the shell machine(s).
- <li>Copy fs_passwd/fs_passwd to /usr/local/bin on the shell machine(s). (chown freeside, chmod 4755). You may link it to passwd, chfn and chsh as well.
- <li>Copy fs_passwd/fs_passwdd to /usr/local/sbin on the shell machine(s). (chown freeside, chmod 500)
- <li>Create /usr/local/freeside on the shell machine(s). (chown freeside, chmod 700)
- <li>Run an iteration of "fs_passwd/fs_passwd_server shell.machine" as the freeside user for each shell machine (this is a daemon process).
-</ul>
-</body>
+++ /dev/null
-<head>
- <title>Schema reference</title>
-</head>
-<body>
- <h1>Schema reference</h1>
- <ul>
- <li><a name="agent">agent</a> - Agents are resellers of your service. Agents may be limited to a subset of your full offerings (via their agent type).
- <ul>
- <li>agentnum - primary key
- <li>agent - name of this agent
- <li>typenum - <a href="#agent_type">agent type</a>
- <li>prog - (unimplemented)
- <li>freq - (unimplemented)
- </ul>
- <li><a name="agent_type">agent_type</a> - Agent types define groups of packages that you can then assign to particular agents.
- <ul>
- <li>typenum - primary key
- <li>atype - name of this agent type
- </ul>
- <li><a name="cust_bill">cust_bill</a> - Invoices
- <ul>
- <li>invnum - primary key
- <li>custnum - <a href="#cust_main">customer</a>
- <li>_date
- <li>charged - amount of this invoice
- <li>owed - amount still outstanding on this invoice
- <li>printed - how many times this invoice has been printed automatically
- </ul>
- <li><a name="cust_bill_pkg">cust_bill_pkg</a> - Invoice line items
- <ul>
- <li>invnum - (multiple) key
- <li>pkgnum - <a href="#cust_pkg">package</a>
- <li>setup - setup fee
- <li>recur - recurring fee
- <li>sdate - starting date
- <li>edate - ending date
- </ul>
- <li><a name="cust_credit">cust_credit</a> - Credits
- <ul>
- <li>crednum - primary key
- <li>custnum - <a href="#cust_main">customer</a>
- <li>amount - amount credited
- <li>credited - amount still outstanding (not yet refunded) on this credit
- <li>_date
- <li>otaker - order taker
- <li>reason
- </ul>
- <li><a name="cust_main">cust_main</a> - Customers
- <ul>
- <li>custnum - primary key
- <li>agentnum - <a href="#agent">agent</a>
- <li>refnum - <a href="#part_referral">referral</a>
- <li>first - name
- <li>last - name
- <li>ss - social security number
- <li>company
- <li>address1
- <li>address2
- <li>city
- <li>county
- <li>state
- <li>zip
- <li>country
- <li>daytime - phone
- <li>night - phone
- <li>payby - CARD, BILL, or COMP
- <li>payinfo - card number, P.O.#, or comp issuer
- <li>paydate - expiration date
- <li>payname - billing name (name on card)
- <li>tax - tax exempt, Y or null
- <li>otaker - order taker
- </ul>
- <li><a name="cust_main_county">cust_main_county</a> - Tax rates
- <ul>
- <li>taxnum - primary key
- <li>state
- <li>county
- <li>tax - % rate
- </ul>
- <li><a name="cust_pay">cust_pay</a> - Payments
- <ul>
- <li>paynum - primary key
- <li>invnum - <a href="#cust_bill">invoice</a>
- <li>paid - amount
- <li>_date
- <li>payby - CARD, BILL, or COMP
- <li>payinfo - card number, P.O.#, or comp issuer
- <li>paybatch - text field for tracking card processor batches
- </ul>
- <li><a name="cust_pay_batch">cust_pay_batch</a> - Pending batch
- <ul>
- <li>trancode - 77 for charges
- <li>cardnum
- <li>exp - card expiration
- <li>amount
- <li>invnum - <a href="#cust_bill">invoice</a>
- <li>custnum - <a href="#cust_main">customer</a>
- <li>payname - name on card
- <li>first - name
- <li>last - name
- <li>address1
- <li>address2
- <li>city
- <li>state
- <li>zip
- <li>country
- </ul>
- <li><a name="cust_pkg">cust_pkg</a> - Customer billing items
- <ul>
- <li>pkgnum - primary key
- <li>custnum - <a href="#cust_main">customer</a>
- <li>pkgpart - <a href="#part_pkg">Package definition</a>
- <li>setup - date
- <li>bill - next bill date
- <li>susp - (past) suspension date
- <li>expire - (future) cancellation date
- <li>cancel - (past) cancellation date
- <li>otaker - order taker
- </ul>
- <li><a name="cust_refund">cust_refund</a> - Refunds
- <ul>
- <li>refundnum - primary key
- <li>crednum - <a href="#cust_credit">credit</a>
- <li>refund - amount
- <li>_date
- <li>payby - CARD, BILL or COMP
- <li>payinfo - card number, P.O.#, or comp issuer
- <li>otaker - order taker
- </ul>
- <li><a name="cust_svc">cust_svc</a> - Customer services
- <ul>
- <li>svcnum - primary key
- <li>pkgnum - <a href="#cust_pkg">package</a>
- <li>svcpart - <a href="#part_svc">Service definition</a>
- </ul>
- <li><a name="part_pkg">part_pkg</a> - Package definitions
- <ul>
- <li>pkgpart - primary key
- <li>pkg - package name
- <li>comment - non-customer visable package comment
- <li>setup - setup fee
- <li>freq - recurring frequency (months)
- <li>recur - recurring fee
- </ul>
- <li><a name="part_referral">part_referral</a> - Referral listing
- <ul>
- <li>refnum</li> - primary key
- <li>referral</li> - referral
- </ul>
- <li><a name="part_svc">part_svc</a> - Service definitions
- <ul>
- <li>svcpart - primary key
- <li>svc - name of this service
- <li>svcdb - table used for this service: svc_acct, svc_acct_sm, svc_domain, svc_charge or svc_wo
- <li><i>table</i>__<i>field</i> - Default or fixed value for <i>field</i> in <i>table</i>
- <li><i>table</i>__<i>field</i>_flag - null, D or F
- </ul>
- <li><a name="pkg_svc">pkg_svc</a>
- <ul>
- <li>pkgpart - <a href="#part_pkg">Package definition</a>
- <li>svcpart - <a href="#part_svc">Service definition</a>
- <li>quantity - quantity of this service that this package includes
- </ul>
- <li><a name="svc_acct">svc_acct</a> - Accounts
- <ul>
- <li>svcnum - <a href="#cust_svc">primary key</a>
- <li>username
- <li>_password
- <li>popnum - <a href="#svc_acct_pop">Point of Presence</a>
- <li>uid
- <li>gid
- <li>finger - GECOS
- <li>dir
- <li>shell
- <li>quota - (unimplementd)
- <li>slipip - IP address
- <li>radius_<i>Radius_Attribute</i> - Radius-Attribute
- </ul>
- <li><a name="svc_acct_pop">svc_acct_pop</a> - Points of Presence
- <ul>
- <li>popnum - primary key
- <li>city
- <li>state
- <li>ac - area code
- <li>exch - exchange
- </ul>
- <li><a name="svc_acct_sm">svc_acct_sm</a> - Domain mail aliases
- <ul>
- <li>svcnum - <a href="#cust_svc">primary key</a>
- <li>domsvc - <a href="#svc_domain">Domain</a> (by svcnum)
- <li>domuid - <a href="#svc_acct">Account</a> (by uid)
- <li>domuser - domuser @ <a href="#svc_domain">Domain</a> forwards to <a href="#svc_acct">Account</a>
- </ul>
- <li><a name="svc_domain">svc_domain</a> - Domains
- <ul>
- <li>svcnum - <a href="#cust_svc">primary key</a>
- <li>domain
- </ul>
- <li><a name="type_pkgs">type_pkgs</a>
- <ul>
- <li>typenum - <a href="#agent_type">agent type</a>
- <li>pkgpart - <a href="#part_pkg">Package definition</a>
- </ul>
- </ul>
-</body>
+++ /dev/null
-<head>
- <title>Troubleshooting</title>
-</head>
-<body>
- <h1>Troubleshooting</h1>
- <ul>
- <li>When troubleshooting the web interface, helpful information is often in your web server's error log.
- <li>Internet Explorer will not work with Freeside's HTML interface.
-<a HREF="http://www.netscape.com">Netscape</a>,
-<a HREF="http://lynx.browser.org">Lynx</a>, and
-<a HREF="http://www.cs.indiana.edu/elisp/w3/docs.html">Emacs/W3</a>,
-among others, should work fine.
- <li>If bin/svc_acct.import fails with an "Out of memory!" error using MySQL, upgrede MySQL and recompile the Perl DBD. There was a memory leak in some older versions of MySQL.
- <li>If you get tons of errors in your web server's error log like this:
-<pre>
-Ambiguous use of value => resolved to "value" =>
-at /usr/lib/perl5/site_perl/File/CounterFile.pm line 132.
-</pre>
- This clutters up your log files but is otherwise harmless. Upgrade to the latest File::CounterFile.
- <li>If you get an Internal Server Error when adding or editing, but find that the update has occured, and you get something like the following in your web server's error log:
-<pre>
-access to <i>/your/path</i>/edit/process/<i>some_table</i>.cgi failed for
-<i>machine.domain.tld</i>, reason: malformed header from script.
-Bad header=HTTP/1.0 302 Moved Temporarily
-</pre>
- Then you forgot to apply this <a href="CGI-modules-2.76-patch.txt">patch</a> as mentioned in the <a href="install.html">New Installation</a> section of the documentation.
- <li>If you get errors like this:
-<pre>
-UID.pm: Can't open /var/spool/freeside/conf/secrets: Permission denied
-at <i>/your/path</i>/site_perl/FS/UID.pm line 26.
-BEGIN failed--compilation aborted at
-<i>/your/path</i>/edit/process/part_svc.cgi line 15.
-</pre>
- Then the scripts are not running setuid freeside. If you were editing
-the files, it is possible you inadvertantly removed the setuid bit.
-As mentioned in the <a href="install.html">New Installation</a> section of the documentation, set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see <a href="http://www.perl.com/CPAN-local/doc/manual/html/pod/perlsec.html#Security_Bugs">perlsec: Security Bugs</a> for information and workarounds.
-<pre>cd /usr/local/apache/htdocs/freeside
-chown -R freeside .
-chmod 4755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi</pre>
- </ul>
-</body>
+++ /dev/null
-<head>
- <title>Upgrading to 1.1.x</title>
-</head>
-<body>
-<h1>Upgrading to 1.1.x</h1>
-<ul>
- <li>Back up your data and current Freeside installation.
- <li>Unpack a copy of the 1.0.0 distribution in a separate location.
- <li>Diff your current installation against the 1.0.0 distribution.
- <li>Apply all the diffs you found above, if applicable.
- <li>Apply (at least) the following changes to your database:
-<pre>
-ALTER TABLE cust_main CHANGE ss ss char(11) NULL;
-ALTER TABLE cust_main CHANGE day daytime varchar(20) NULL;
-ALTER TABLE svc_acct CHANGE password _password varchar(25) NOT NULL;
-ALTER TABLE part_svc CHANGE svc_acct__password svc_acct___password varchar(25) NULL;
-ALTER TABLE part_svc CHANGE svc_acct__password_flag svc_acct___password_flag char(1) NULL;
-ALTER TABLE agent_type CHANGE type atype varchar(80) NOT NULL;
-</pre>
- <li>Optionally change the field lengths and types to match a 1.1.x install; see `bin/fs-setup'.
- <li>Create the necessary <a href="config.html">configuration files</a>,
- <li>Copy or symlink htdocs and site_perl to the new 1.1.x copies.
- <li>Run bin/dbdef-create. This file uses MySQL-specific syntax. If you are running a different database engine you will need to modify it slightly.
-</body>
+++ /dev/null
-<head>
- <title>Upgrading to 1.1.3</title>
-</head>
-<body>
-<h1>Upgrading to 1.1.3 from 1.1.x</h1>
-<ul>
- <li>If migrating from 1.0.0, see these <a href="upgrade.html">instructions</a> first.
- <li>Back up your data and current Freeside installation.
- <li>If applicable, create the new <a href="config.html">configuration files</a>: lpr, cybercash2, cybercash3.2
- <li>Copy or symlink htdocs and site_perl to the new copies.
-</body>
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent.cgi: Add/Edit agent (output form)
-#
-# ivan@sisd.com 97-dec-12
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'type' to 'atype' because Pg6.3 reserves the type word
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($agent,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $agent=qsearchs('agent',{'agentnum'=>$1});
- $action='Edit';
-} else { #adding
- $agent=create FS::agent {};
- $action='Add';
-}
-my($hashref)=$agent->hashref;
-
-print header("$action Agent", menubar(
- 'Main Menu' => '../',
- 'View all agents' => '../browse/agent.cgi',
-)), '<FORM ACTION="process/agent.cgi" METHOD=POST>';
-
-print qq!<INPUT TYPE="hidden" NAME="agentnum" VALUE="$hashref->{agentnum}">!,
- "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)";
-
-print <<END;
-<PRE>
-Agent <INPUT TYPE="text" NAME="agent" SIZE=32 VALUE="$hashref->{agent}">
-Agent type <SELECT NAME="typenum" SIZE=1>
-END
-
-my($agent_type);
-foreach $agent_type (qsearch('agent_type',{})) {
- print "<OPTION";
- print " SELECTED"
- if $hashref->{typenum} == $agent_type->getfield('typenum');
- print ">", $agent_type->getfield('typenum'), ": ",
- $agent_type->getfield('atype'),"\n";
-}
-
-print <<END;
-</SELECT>
-Frequency (unimplemented) <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
-Program (unimplemented) <INPUT TYPE="text" NAME="prog" VALUE="$hashref->{prog}">
-</PRE>
-END
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{agentnum} ? "Apply changes" : "Add agent",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent_type.cgi: Add/Edit agent type (output form)
-#
-# ivan@sisd.com 97-dec-10
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'type' to 'atype' because Pg6.3 reserves the type word
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent_type;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($agent_type,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $agent_type=qsearchs('agent_type',{'typenum'=>$1});
- $action='Edit';
-} else { #adding
- $agent_type=create FS::agent_type {};
- $action='Add';
-}
-my($hashref)=$agent_type->hashref;
-
-print header("$action Agent Type", menubar(
- 'Main Menu' => '../',
- 'View all agent types' => '../browse/agent_type.cgi',
-)), '<FORM ACTION="process/agent_type.cgi" METHOD=POST>';
-
-print qq!<INPUT TYPE="hidden" NAME="typenum" VALUE="$hashref->{typenum}">!,
- "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)";
-
-print <<END;
-<BR>Type <INPUT TYPE="text" NAME="atype" SIZE=32 VALUE="$hashref->{atype}">
-<P>Select which packages agents of this type may sell to customers</P>
-END
-
-my($part_pkg);
-foreach $part_pkg ( qsearch('part_pkg',{}) ) {
- print qq!<BR><INPUT TYPE="checkbox" NAME="pkgpart!,
- $part_pkg->getfield('pkgpart'), qq!" !,
- # ( 'CHECKED 'x scalar(
- qsearchs('type_pkgs',{
- 'typenum' => $agent_type->getfield('typenum'),
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
- })
- ? 'CHECKED '
- : '',
- qq!"VALUE="ON"> !,$part_pkg->getfield('pkg')
- ;
-}
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{typenum} ? "Apply changes" : "Add agent type",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_credit.cgi: Add a credit (output form)
-#
-# Usage: cust_credit.cgi custnum [ -paybatch ]
-# http://server.name/path/cust_credit?custnum [ -paybatch ]
-#
-# Note: Should be run setuid root as user nobody.
-#
-# some hooks in here for modifications as well as additions, but needs (lots) more work.
-# also see process/cust_credit.cgi, the script that processes the form.
-#
-# ivan@voicenet.com 96-dec-05
-#
-# paybatch field, differentiates between credits & credits+refunds by commandline
-# ivan@voicenet.com 96-dec-08
-#
-# added (but commented out) sprintf("%.2f" in amount field. Hmm.
-# ivan@voicenet.com 97-jan-3
-#
-# paybatch stuff thrown out - has checkbox now instead.
-# (well, sort of. still passed around for backward compatability and possible editing hook)
-# ivan@voicenet.com 97-apr-21
-#
-# rewrite ivan@sisd.com 98-mar-16
-
-use strict;
-use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); #CGI module
-use FS::UID qw(cgisuidsetup getotaker);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-
-#untaint otaker
-my($otaker)=getotaker;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Post Credit</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Post Credit</H1>
- </CENTER>
- <FORM ACTION="process/cust_credit.cgi" METHOD=POST>
- <HR><PRE>
-END
-
-#crednum
-my($crednum)="";
-print qq!Credit #<B>!, $crednum ? $crednum : " <I>(NEW)</I>", qq!</B><INPUT TYPE="hidden" NAME="crednum" VALUE="$crednum">!;
-
-#custnum
-print qq!\nCustomer #<B>$custnum</B><INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!;
-
-#paybatch
-print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
-
-#date
-my($date)=time;
-print qq!\nDate: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
-
-#amount
-my($amount)='';
-print qq!\nAmount \$<INPUT TYPE="text" NAME="amount" VALUE="$amount" SIZE=8 MAXLENGTH=8>!;
-
-#refund?
-#print qq! <INPUT TYPE="checkbox" NAME="refund" VALUE="yes">Also post refund!;
-
-#otaker (hidden)
-print qq!<INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">!;
-
-#reason
-my($reason)='';
-print qq!\nReason <INPUT TYPE="text" NAME="reason" VALUE="$reason" SIZE=72>!;
-
-print <<END;
-</PRE>
-<BR>
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
-END
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main.cgi: Edit a customer (output form)
-#
-# Usage: cust_main.cgi custnum
-# http://server.name/path/cust_main.cgi?custnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 96-nov-29 -> 96-dec-04
-#
-# Blank custnum for new customer.
-# ivan@voicenet.com 96-dec-16
-#
-# referral defaults to blank, to force people to pick something
-# ivan@voicenet.com 97-jun-4
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-28
-#
-# new customer is null, not '#'
-# otaker gotten from &getotaker instead of $ENV{REMOTE_USER}
-# ivan@sisd.com 97-nov-12
-#
-# cgisuidsetup($cgi);
-# no need for old_ fields.
-# now state+county is a select field (took out PA hack)
-# used autoloaded $cust_main->field methods
-# ivan@sisd.com 97-dec-17
-#
-# fixed quoting problems ivan@sisd.com 98-feb-23
-#
-# paydate sql update ivan@sisd.com 98-mar-5
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
-# Added test for paydate in mm-dd-yyyy format for Pg6.3 default format
-# bmccane@maxbaud.net 98-apr-3
-#
-# fixed one missed day->daytime ivan@sisd.com 98-jul-13
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::cust_main;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-#get record
-my($custnum,$action,$cust_main);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $custnum=$1;
- $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
- $action='Edit';
-} else {
- $custnum='';
- $cust_main = create FS::cust_main ( {} );
- $cust_main->setfield('otaker',&getotaker);
- $cust_main->setfield('country','US');
- $action='Add';
-}
-
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Customer $action</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Customer $action</H1>
- </CENTER>
- <FORM ACTION="process/cust_main.cgi" METHOD=POST>
- <PRE>
-END
-
-print qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!,
- qq!Customer #<FONT SIZE="+1"><B>!;
-print $custnum ? $custnum : " (NEW)" , "</B></FONT>";
-
-#agentnum
-my($agentnum)=$cust_main->agentnum || 1; #set to first agent by default
-my(@agents) = qsearch('agent',{});
-print qq!\n\nAgent # <SELECT NAME="agentnum" SIZE="1">!;
-my($agent);
-foreach $agent (sort {
- $a->agent cmp $b->agent;
-} @agents) {
- print "<OPTION" . " SELECTED"x($agent->agentnum==$agentnum),
- ">", $agent->agentnum,": ", $agent->agent, "\n";
-}
-print "</SELECT>";
-
-#referral
-#unless ($custnum) {
- my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error
- my(@referrals) = qsearch('part_referral',{});
- print qq!\nReferral <SELECT NAME="refnum" SIZE="1">!;
- print "<OPTION> \n";
- my($referral);
- foreach $referral (sort {
- $a->refnum <=> $b->refnum;
- } @referrals) {
- print "<OPTION" . " SELECTED"x($referral->refnum==$refnum),
- ">", $referral->refnum, ": ", $referral->referral,"\n";
- }
- print "</SELECT>";
-#}
-
-my($last,$first,$ss,$company,$address1,$address2,$city)=(
- $cust_main->last,
- $cust_main->first,
- $cust_main->ss,
- $cust_main->company,
- $cust_main->address1,
- $cust_main->address2,
- $cust_main->city,
-);
-
-print <<END;
-
-
-Name (last)<INPUT TYPE="text" NAME="last" VALUE="$last"> (first)<INPUT TYPE="text" NAME="first" VALUE="$first"> SS# <INPUT TYPE="text" NAME="ss" VALUE="$ss" SIZE=11 MAXLENGTH=11>
-Company <INPUT TYPE="text" NAME="company" VALUE="$company">
-Address <INPUT TYPE="text" NAME="address1" VALUE="$address1" SIZE=40 MAXLENGTH=40>
- <INPUT TYPE="text" NAME="address2" VALUE="$address2" SIZE=40 MAXLENGTH=40>
-City <INPUT TYPE="text" NAME="city" VALUE="$city"> State (county) <SELECT NAME="state" SIZE="1">
-END
-
-foreach ( qsearch('cust_main_county',{}) ) {
- print "<OPTION";
- print " SELECTED" if ( $cust_main->state eq $_->state
- && $cust_main->county eq $_->county );
- print ">",$_->state;
- print " (",$_->county,")" if $_->county;
-}
-print "</SELECT>";
-
-my($zip,$country,$daytime,$night,$fax)=(
- $cust_main->zip,
- $cust_main->country,
- $cust_main->daytime,
- $cust_main->night,
- $cust_main->fax,
-);
-
-print <<END;
- Zip <INPUT TYPE="text" NAME="zip" VALUE="$zip" SIZE=10 MAXLENGTH=10>
-Country: <FONT SIZE="+1"><B>$country</B></FONT><INPUT TYPE="hidden" NAME="country" VALUE="$country">
-
-Phone (daytime)<INPUT TYPE="text" NAME="daytime" VALUE="$daytime" SIZE=18 MAXLENGTH=20> (night)<INPUT TYPE="text" NAME="night" VALUE="$night" SIZE=18 MAXLENGTH=20> (fax)<INPUT TYPE="text" NAME="fax" VALUE="$fax" SIZE=12 MAXLENGTH=12>
-
-END
-
-my(%payby)=(
- 'CARD' => "Credit card ",
- 'BILL' => "Billing ",
- 'COMP' => "Complimentary",
-);
-for (qw(CARD BILL COMP)) {
- print qq!<INPUT TYPE="radio" NAME="payby" VALUE="$_"!;
- print qq! CHECKED! if ($cust_main->payby eq "$_");
- print qq!>$payby{$_}!;
-}
-
-
-my($payinfo,$payname,$otaker)=(
- $cust_main->payinfo,
- $cust_main->payname,
- $cust_main->otaker,
-);
-
-my($paydate);
-if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) {
- $paydate="$2/$1"
-} elsif ( $cust_main->paydate =~ /^(\d{2})-\d{2}-(\d{4}$)/ ) {
- $paydate="$1/$2"
-}
-else {
- $paydate='';
-}
-
-print <<END;
-
- Card number , P.O. # or Authorization <INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo" SIZE=19 MAXLENGTH=19>
-END
-
-print qq!Exp. date (MM/YY or MM/YYYY)<INPUT TYPE="text" NAME="paydate" VALUE="$paydate" SIZE=8 MAXLENGTH=7> Billing name <INPUT TYPE="text" NAME="payname" VALUE="$payname">\n<INPUT TYPE="checkbox" NAME="tax" VALUE="Y"!;
-print qq! CHECKED! if $cust_main->tax eq "Y";
-print qq!> Tax Exempt!;
-
-print <<END;
-
-
-Order taken by: <FONT SIZE="+1"><B>$otaker</B></FONT><INPUT TYPE="hidden" NAME="otaker" VALUE="$otaker">
-</PRE>
-END
-
-print qq!<CENTER><INPUT TYPE="submit" VALUE="!,
- $custnum ? "Apply Changes" : "Add Customer", qq!"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main_county-expand.cgi: Expand a state into counties (output form)
-#
-# ivan@sisd.com 97-dec-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-$cgi->var('QUERY_STRING') =~ /^(\d+)$/
- or die "Illegal taxnum!";
-my($taxnum)=$1;
-
-my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum});
-die "Can't expand entry!" if $cust_main_county->getfield('county');
-
-print header("Tax Rate (expand state)", menubar(
- 'Main Menu' => '../',
-)), <<END;
- <FORM ACTION="process/cust_main_county-expand.cgi" METHOD=POST>
- <INPUT TYPE="hidden" NAME="taxnum" VALUE="$taxnum">
- Separate counties by
- <INPUT TYPE="radio" NAME="delim" VALUE="n" CHECKED>line
- (rumor has it broken on some browsers) or
- <INPUT TYPE="radio" NAME="delim" VALUE="s">whitespace.
- <BR><INPUT TYPE="submit" VALUE="Submit">
- <BR><TEXTAREA NAME="counties" ROWS=100></TEXTAREA>
- </FORM>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main_county.cgi: Edit tax rates (output form)
-#
-# ivan@sisd.com 97-dec-13-16
-#
-# Changes to allow page to work at a relative position in server
-# Changed tax field to accept 6 chars (MO uses 6.1%)
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-print header("Edit tax rates", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <FORM ACTION="process/cust_main_county.cgi" METHOD=POST>
- <TABLE BORDER>
- <TR>
- <TH><FONT SIZE=-1>State</FONT></TH>
- <TH>County</TH>
- <TH><FONT SIZE=-1>Tax</FONT></TH>
- </TR>
-END
-
-my($cust_main_county);
-foreach $cust_main_county ( qsearch('cust_main_county',{}) ) {
- my($hashref)=$cust_main_county->hashref;
- print <<END;
- <TR>
- <TD>$hashref->{state}</TD>
-END
-
- print "<TD>", $hashref->{county}
- ? $hashref->{county}
- : '(ALL)'
- , "</TD>";
-
- print qq!<TD><INPUT TYPE="text" NAME="tax!, $hashref->{taxnum},
- qq!" VALUE="!, $hashref->{tax}, qq!" SIZE=6 MAXLENGTH=6>%</TD></TR>!;
-END
-
-}
-
-print <<END;
- </TABLE>
- <INPUT TYPE="submit" VALUE="Apply changes">
- </FORM>
- </CENTER>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pay.cgi: Add a payment (output form)
-#
-# Usage: cust_pay.cgi invnum
-# http://server.name/path/cust_pay.cgi?invnum
-#
-# Note: Should be run setuid as user nobody.
-#
-# some hooks for modifications as well as additions, but needs work.
-#
-# ivan@voicenet.com 96-dec-11
-#
-# rewrite ivan@sisd.com 98-mar-16
-
-use strict;
-use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Enter payment</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Enter payment</H1>
- </CENTER>
- <FORM ACTION="process/cust_pay.cgi" METHOD=POST>
- <HR><PRE>
-END
-
-#invnum
-print qq!Invoice #<B>$invnum</B><INPUT TYPE="hidden" NAME="invnum" VALUE="$invnum">!;
-
-#date
-my($date)=time;
-print qq!<BR>Date: <B>!, time2str("%D",$date), qq!</B><INPUT TYPE="hidden" NAME="_date" VALUE="$date">!;
-
-#paid
-print qq!<BR>Amount \$<INPUT TYPE="text" NAME="paid" VALUE="" SIZE=8 MAXLENGTH=8>!;
-
-#payby
-my($payby)="BILL";
-print qq!<BR>Payby: <B>$payby</B><INPUT TYPE="hidden" NAME="payby" VALUE="$payby">!;
-
-#payinfo (check # now as payby="BILL" hardcoded.. what to do later?)
-my($payinfo)="";
-print qq!<BR>Check #<INPUT TYPE="text" NAME="payinfo" VALUE="$payinfo">!;
-
-#paybatch
-print qq!<INPUT TYPE="hidden" NAME="paybatch" VALUE="">!;
-
-print <<END;
-</PRE>
-<BR>
-<CENTER><INPUT TYPE="submit" VALUE="Post"></CENTER>
-END
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pkg.cgi: Add/edit packages (output form)
-#
-# this is for changing packages around, not editing things within the package
-#
-# Usage: cust_pkg.cgi custnum
-# http://server.name/path/cust_pkg.cgi?custnum
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# started with /sales/add/cust_pkg.cgi, which added packages
-# ivan@voicenet.com 97-jan-5, 97-mar-21
-#
-# Rewrote for new API
-# ivan@voicenet.com 97-jul-7
-#
-# FS::Search is no more, &cgisuidsetup needs $cgi, ivan@sisd.com 98-mar-7
-#
-# Changes to allow page to work at a relative position in server
-# Changed to display packages 2-wide in a table
-# bmccane@maxbaud.net 98-apr-3
-#
-# fixed a pretty cool bug from above which caused a visual glitch ivan@sisd.com
-# 98-jun-1
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-my(%pkg,%comment);
-foreach (qsearch('part_pkg', {})) {
- $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg');
- $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment');
-}
-
-#untaint custnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-
-my($otaker)=&getotaker;
-
-SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Add/Edit Packages</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Add/Edit Packages</H1>
- </CENTER>
- <FORM ACTION="process/cust_pkg.cgi" METHOD=POST>
- <HR>
-END
-
-#custnum
-print qq!<INPUT TYPE="hidden" NAME="new_custnum" VALUE="$custnum">!;
-
-#current packages (except cancelled packages)
-my(@cust_pkg) = grep ! $_->getfield('cancel'),
- qsearch('cust_pkg',{'custnum'=>$custnum});
-
-if (@cust_pkg) {
- print <<END;
-<CENTER><FONT SIZE="+2">Current packages</FONT></CENTER>
-These are packages the customer currently has. Select those packages you
-wish to remove (if any).<BR><BR>
-END
-
- my ($count) = 0 ;
- print qq!<CENTER><TABLE>! ;
- foreach (@cust_pkg) {
- print qq!<TR>! if ($count ==0) ;
- my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') );
- print qq!<TD><INPUT TYPE="checkbox" NAME="remove_pkg" VALUE="$pkgnum">!,
- #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!,
- #now you've got to admit this bug was pretty cool
- qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n!;
- $count ++ ;
- if ($count == 2)
- {
- $count = 0 ;
- print qq!</TR>\n! ;
- }
- }
- print qq!</TABLE></CENTER>! ;
-
- print "<HR>";
-}
-
-print <<END;
-<CENTER><FONT SIZE="+2">New packages</FONT></CENTER>
-These are packages the customer can purchase. Specify the quantity to add
-of each package.<BR><BR>
-END
-
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
-
-my($type_pkgs);
-my ($count) = 0 ;
-print qq!<CENTER><TABLE>! ;
-foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
- my($pkgpart)=$type_pkgs->pkgpart;
- print qq!<TR>! if ($count == 0) ;
- print <<END;
- <TD>
- <INPUT TYPE="text" NAME="pkg$pkgpart" VALUE="0" SIZE="2" MAXLENGTH="2">
- $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}</TD>\n
-END
- $count ++ ;
- if ($count == 2)
- {
- print qq!</TR>\n! ;
- $count = 0 ;
- }
-}
-print qq!</TABLE></CENTER>! ;
-
-#otaker
-print qq!<INPUT TYPE="hidden" NAME="new_otaker" VALUE="$otaker">\n!;
-
-#submit
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Order"></CENTER>\n!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_pkg.cgi: Add/Edit package (output form)
-#
-# ivan@sisd.com 97-dec-10
-#
-# Changes to allow page to work at a relative position in server
-# Changed to display services 2-wide in table
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg;
-use FS::pkg_svc;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($part_pkg,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1});
- $action='Edit';
-} else { #adding
- $part_pkg=create FS::part_pkg {};
- $action='Add';
-}
-my($hashref)=$part_pkg->hashref;
-
-print header("$action Package Definition", menubar(
- 'Main Menu' => '../',
- 'View all packages' => '../browse/part_pkg.cgi',
-)), '<FORM ACTION="process/part_pkg.cgi" METHOD=POST>';
-
-print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!,
- "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)";
-
-print <<END;
-<PRE>
-Package (customer-visable) <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}">
-Comment (customer-hidden) <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}">
-Setup fee for this package <INPUT TYPE="text" NAME="setup" VALUE="$hashref->{setup}">
-Recurring fee for this package <INPUT TYPE="text" NAME="recur" VALUE="$hashref->{recur}">
-Frequency (months) of recurring fee <INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}">
-
-</PRE>
-
-Enter the quantity of each service this package includes.<BR><BR>
-<TABLE BORDER><TR><TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH>
- <TH><FONT SIZE=-1>Quan.</FONT></TH><TH>Service</TH></TR>
-END
-
-my($part_svc);
-my($count) = 0 ;
-foreach $part_svc ( qsearch('part_svc',{}) ) {
-
- my($svcpart)=$part_svc->getfield('svcpart');
- my($pkg_svc)=qsearchs('pkg_svc',{
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
- 'svcpart' => $svcpart,
- }) || create FS::pkg_svc({
- 'pkgpart' => $part_pkg->getfield('pkgpart'),
- 'svcpart' => $svcpart,
- 'quantity' => 0,
- });
- next unless $pkg_svc;
-
- print qq!<TR>! if $count == 0 ;
- print qq!<TD><INPUT TYPE="text" NAME="pkg_svc$svcpart" SIZE=3 VALUE="!,
- $pkg_svc->getfield('quantity') || 0,qq!"></TD>!,
- qq!<TD><A HREF="part_svc.cgi?!,$part_svc->getfield('svcpart'),
- qq!">!, $part_svc->getfield('svc'), "</A></TD>";
- $count ++ ;
- if ($count == 2)
- {
- print qq!</TR>! ;
- $count = 0 ;
- }
-}
-print qq!</TR>! if ($count != 0) ;
-
-print "</TABLE>";
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{pkgpart} ? "Apply changes" : "Add package",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# agent.cgi: Add/Edit referral (output form)
-#
-# ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# confisuing typo on submit button ivan@sisd.com 98-jun-14
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_referral;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($part_referral,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_referral=qsearchs('part_referral',{'refnum'=>$1});
- $action='Edit';
-} else { #adding
- $part_referral=create FS::part_referral {};
- $action='Add';
-}
-my($hashref)=$part_referral->hashref;
-
-print header("$action Referral", menubar(
- 'Main Menu' => '../',
- 'View all referrals' => "../browse/part_referral.cgi",
-)), <<END;
- <FORM ACTION="process/part_referral.cgi" METHOD=POST>
-END
-
-#display
-
-print qq!<INPUT TYPE="hidden" NAME="refnum" VALUE="$hashref->{refnum}">!,
- "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)";
-
-print <<END;
-<PRE>
-Referral <INPUT TYPE="text" NAME="referral" SIZE=32 VALUE="$hashref->{referral}">
-</PRE>
-END
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{refnum} ? "Apply changes" : "Add referral",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# part_svc.cgi: Add/Edit service (output form)
-#
-# ivan@sisd.com 97-nov-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::part_svc qw(fields);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($part_svc,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $part_svc=qsearchs('part_svc',{'svcpart'=>$1});
- $action='Edit';
-} else { #adding
- $part_svc=create FS::part_svc {};
- $action='Add';
-}
-my($hashref)=$part_svc->hashref;
-
-print header("$action Service Definition", menubar(
- 'Main Menu' => '../',
- 'View all services' => '../browse/part_svc.cgi',
-)), '<FORM ACTION="process/part_svc.cgi" METHOD=POST>';
-
-
-
-print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$hashref->{svcpart}">!,
- "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)";
-
-print <<END;
-<PRE>
-Service <INPUT TYPE="text" NAME="svc" VALUE="$hashref->{svc}">
-Table <SELECT NAME="svcdb" SIZE=1>
-END
-
-print map '<OPTION'. ' SELECTED'x($_ eq $hashref->{svcdb}). ">$_\n", qw(
- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
-);
-
-print <<END;
-</SELECT></PRE>
-Services are items you offer to your customers.
-<UL><LI>svc_acct - Shell accounts, POP mailboxes, SLIP/PPP and ISDN accounts
- <LI>svc_domain - Virtual domains
- <LI>svc_acct_sm - Virtual domain mail aliasing
- <LI>svc_charge - One-time charges (Partially unimplemented)
- <LI>svc_wo - Work orders (Partially unimplemented)
-</UL>
-For the columns in the table selected above, you can set default or fixed
-values. For example, a SLIP/PPP account may have a default (or perhaps fixed)
-<B>slipip</B> of <B>0.0.0.0</B>, while a POP mailbox will probably have a fixed
-blank <B>slipip</B> as well as a fixed shell something like <B>/bin/true</B> or
-<B>/usr/bin/passwd</B>.
-<BR><BR>
-<TABLE BORDER CELLPADDING=4><TR><TH>Table</TH><TH>Field</TH>
-<TH COLSPAN=2>Modifier</TH></TR>
-END
-
-#these might belong somewhere else for other user interfaces
-#pry need to eventually create stuff that's shared amount UIs
-my(%defs)=(
- 'svc_acct' => {
- 'dir' => 'Home directory',
- 'uid' => 'UID (set to fixed and blank for dial-only)',
- 'slipip' => 'IP address',
- 'popnum' => '<A HREF="../browse/svc_acct_pop.cgi/">POP number</A>',
- 'username' => 'Username',
- 'quota' => '(unimplemented)',
- '_password' => 'Password',
- 'gid' => 'GID (when blank, defaults to UID)',
- 'shell' => 'Shell',
- 'finger' => 'GECOS',
- },
- 'svc_domain' => {
- 'domain' => 'Domain',
- },
- 'svc_acct_sm' => {
- 'domuser' => 'domuser@virtualdomain.com',
- 'domuid' => 'UID where domuser@virtualdomain.com mail is forwarded',
- 'domsvc' => 'svcnum from svc_domain for virtualdomain.com',
- },
- 'svc_charge' => {
- 'amount' => 'amount',
- },
- 'svc_wo' => {
- 'worker' => 'Worker',
- '_date' => 'Date',
- },
-);
-
-my($svcdb);
-foreach $svcdb ( qw(
- svc_acct svc_domain svc_acct_sm svc_charge svc_wo
-) ) {
-
- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc');
- my($rowspan)=scalar(@rows);
-
- my($ptmp)="<TD ROWSPAN=$rowspan>$svcdb</TD>";
- my($row);
- foreach $row (@rows) {
- my($value)=$part_svc->getfield($svcdb.'__'.$row);
- my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag');
- print "<TR>$ptmp<TD>$row - <FONT SIZE=-1>$defs{$svcdb}{$row}</FONT></TD>";
- print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE=""!.
- ' CHECKED'x($flag eq ''). "><BR>Off</TD>";
- print qq!<TD><INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="D"!.
- ' CHECKED'x($flag eq 'D'). ">Default ";
- print qq!<INPUT TYPE="radio" NAME="${svcdb}__${row}_flag" VALUE="F"!.
- ' CHECKED'x($flag eq 'F'). ">Fixed ";
- print qq!<BR><INPUT TYPE="text" NAME="${svcdb}__${row}" VALUE="$value">!,
- "</TD></TR>";
- $ptmp='';
- }
-}
-print "</TABLE>";
-
-print qq!\n<CENTER><BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{svcpart} ? "Apply changes" : "Add service",
- qq!"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/agent.cgi: Edit agent (process form)
-#
-# ivan@sisd.com 97-dec-12
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent qw(fields);
-use FS::CGI qw(idiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($agentnum)=$req->param('agentnum');
-
-my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum;
-
-#unmunge typenum
-$req->param('typenum') =~ /^(\d+)(:.*)?$/;
-$req->param('typenum',$1);
-
-my($new)=create FS::agent ( {
- map {
- $_, $req->param($_);
- } fields('agent')
-} );
-
-my($error);
-if ( $agentnum ) {
- $error=$new->replace($old);
-} else {
- $error=$new->insert;
- $agentnum=$new->getfield('agentnum');
-}
-
-if ( $error ) {
- &idiot($error);
-} else {
- #$req->cgi->redirect("../../view/agent.cgi?$agentnum");
- #$req->cgi->redirect("../../edit/agent.cgi?$agentnum");
- $req->cgi->redirect("../../browse/agent.cgi");
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/agent_type.cgi: Edit agent type (process form)
-#
-# ivan@sisd.com 97-dec-11
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::agent_type qw(fields);
-use FS::type_pkgs;
-use FS::CGI qw(idiot);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-my($typenum)=$req->param('typenum');
-my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum;
-
-my($new)=create FS::agent_type ( {
- map {
- $_, $req->param($_);
- } fields('agent_type')
-} );
-
-my($error);
-if ( $typenum ) {
- $error=$new->replace($old);
-} else {
- $error=$new->insert;
- $typenum=$new->getfield('typenum');
-}
-
-if ( $error ) {
- idiot($error);
- exit;
-}
-
-my($part_pkg);
-foreach $part_pkg (qsearch('part_pkg',{})) {
- my($pkgpart)=$part_pkg->getfield('pkgpart');
-
- my($type_pkgs)=qsearchs('type_pkgs',{
- 'typenum' => $typenum,
- 'pkgpart' => $pkgpart,
- });
- if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) {
- my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below.
- $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs,
- #so ->del not ->delete. hmm. hmm.
- if ( $error ) {
- idiot($error);
- exit;
- }
-
- } elsif ( $req->param("pkgpart$pkgpart")
- && ! $type_pkgs
- ) {
- #ok to clobber it now (but bad form nonetheless?)
- $type_pkgs=create FS::type_pkgs ({
- 'typenum' => $typenum,
- 'pkgpart' => $pkgpart,
- });
- $error= $type_pkgs->insert;
- if ( $error ) {
- idiot($error);
- exit;
- }
- }
-
-}
-
-#$req->cgi->redirect("../../view/agent_type.cgi?$typenum");
-#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum");
-$req->cgi->redirect("../../browse/agent_type.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_credit.cgi: Add a credit (process form)
-#
-# Usage: post form to:
-# http://server.name/path/cust_credit.cgi
-#
-# Note: Should be run setuid root as user nobody.
-#
-# ivan@voicenet.com 96-dec-05 -> 96-dec-08
-#
-# post a refund if $new_paybatch
-# ivan@voicenet.com 96-dec-08
-#
-# refunds are no longer applied against a specific payment (paybatch)
-# paybatch field removed
-# ivan@voicenet.com 97-apr-22
-#
-# rewrite ivan@sisd.com 98-mar-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::cust_credit;
-
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
-my($custnum)=$1;
-
-$req->param('otaker',getotaker);
-
-my($new) = create FS::cust_credit ( {
- map {
- $_, $req->param($_);
- } qw(custnum _date amount otaker reason)
-} );
-
-my($error);
-$error=$new->insert;
-&idiot($error) if $error;
-
-#no errors, no refund, so view our credit.
-$req->cgi->redirect("../../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error posting credit/refund</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error posting credit/refund</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again.
- </BODY>
-</HTML>
-END
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_main.cgi: Edit a customer (process form)
-#
-# Usage: post form to:
-# http://server.name/path/cust_main.cgi
-#
-# Note: Should be run setuid root as user nobody.
-#
-# ivan@voicenet.com 96-dec-04
-#
-# added referral check
-# ivan@voicenet.com 97-jun-4
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-28
-#
-# same as above (again) and clean up some stuff ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_main;
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-#create new record object
-
-#unmunge agentnum
-$req->param('agentnum',
- (split(/:/, ($req->param('agentnum'))[0] ))[0]
-);
-
-#unmunge tax
-$req->param('tax','') unless defined($req->param('tax'));
-
-#unmunge refnum
-$req->param('refnum',
- (split(/:/, ($req->param('refnum'))[0] ))[0]
-);
-
-#unmunge state/county
-$req->param('state') =~ /^(\w+)( \((\w+)\))?$/;
-$req->param('state', $1);
-$req->param('county', $3 || '');
-
-my($new) = create FS::cust_main ( {
- map {
- $_, $req->param("$_") || ''
- } qw(custnum agentnum last first ss company address1 address2 city county
- state zip country daytime night fax payby payinfo paydate payname tax
- otaker refnum)
-} );
-
-if ( $new->custnum eq '' ) {
-
- my($error)=$new->insert;
- &idiot($error) if $error;
-
-} else { #create old record object
-
- my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } );
- &idiot("Old record not found!") unless $old;
- my($error)=$new->replace($old);
- &idiot($error) if $error;
-
-}
-
-my($custnum)=$new->custnum;
-$req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_main");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error updating customer information</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error updating customer information</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
- exit;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_main_county-expand.cgi: Expand counties (process form)
-#
-# ivan@sisd.com 97-dec-16
-#
-# Changes to allow page to work at a relative position in server
-# Added import of datasrc from UID.pm for Pg6.3
-# Default tax to 0.0 if using Pg6.3
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI
-# undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record
-# for that state
-#ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup datasrc);
-use FS::Record qw(qsearch qsearchs);
-use FS::cust_main_county;
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!";
-my($taxnum)=$1;
-my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
- or die ("Unknown taxnum!");
-
-my(@counties);
-if ( $req->param('delim') eq 'n' ) {
- @counties=split(/\n/,$req->param('counties'));
-} elsif ( $req->param('delim') eq 's' ) {
- @counties=split(/\s+/,$req->param('counties'));
-} else {
- die "Illegal delim!";
-}
-
-@counties=map {
- /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county");
- $1;
-} @counties;
-
-my($county);
-foreach ( @counties) {
- my(%hash)=$cust_main_county->hash;
- my($new)=create FS::cust_main_county \%hash;
- $new->setfield('taxnum','');
- $new->setfield('county',$_);
- #if (datasrc =~ m/Pg/)
- #{
- # $new->setfield('tax',0.0);
- #}
- my($error)=$new->insert;
- die $error if $error;
-}
-
-unless ( qsearch('cust_main',{
- 'state' => $cust_main_county->getfield('state'),
- 'county' => $cust_main_county->getfield('county'),
-} ) ) {
- my($error)=($cust_main_county->delete);
- die $error if $error;
-}
-
-$req->cgi->redirect("../../edit/cust_main_county.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/agent.cgi: Edit cust_main_county (process form)
-#
-# ivan@sisd.com 97-dec-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::cust_main_county;
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-foreach ( $req->params ) {
- /^tax(\d+)$/ or die "Illegal form $_!";
- my($taxnum)=$1;
- my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum})
- or die "Couldn't find taxnum $taxnum!";
- next unless $old->getfield('tax') ne $req->param("tax$taxnum");
- my(%hash)=$old->hash;
- $hash{tax}=$req->param("tax$taxnum");
- my($new)=create FS::cust_main_county \%hash;
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-}
-
-$req->cgi->redirect("../../browse/cust_main_county.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_pay.cgi: Add a payment (process form)
-#
-# Usage: post form to:
-# http://server.name/path/cust_pay.cgi
-#
-# Note: Should be run setuid root as user nobody.
-#
-# ivan@voicenet.com 96-dec-11
-#
-# rewrite ivan@sisd.com 98-mar-16
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use FS::UID qw(cgisuidsetup);
-use FS::cust_pay qw(fields);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($invnum)=$1;
-
-my($new) = create FS::cust_pay ( {
- map {
- $_, $req->param($_);
- } qw(invnum paid _date payby payinfo paybatch)
-} );
-
-my($error);
-$error=$new->insert;
-
-if ($error) { #error!
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error posting payment</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error posting payment</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and press the <I>Post</I> button again.
- </BODY>
-</HTML>
-END
-} else { #no errors!
- $req->cgi->redirect("../../view/cust_bill.cgi?$invnum");
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_pkg.cgi: Add/edit packages (process form)
-#
-# this is for changing packages around, not for editing things within the
-# package
-#
-# Usage: post form to:
-# http://server.name/path/cust_pkg.cgi
-#
-# Note: Should be run setuid root as user nobody.
-#
-# ivan@voicenet.com 97-mar-21 - 97-mar-24
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-7 - 15
-#
-# &cgisuidsetup($cgi) ivan@sisd.com 98-mar-7
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::cust_pkg;
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-#untaint custnum
-$req->param('new_custnum') =~ /^(\d+)$/;
-my($custnum)=$1;
-
-my(@remove_pkgnums) = map {
- /^(\d+)$/ or die "Illegal remove_pkg value!";
- $1;
-} $req->param('remove_pkg');
-
-my(@pkgparts);
-my($pkgpart);
-foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) {
- my($num_pkgs)=$req->param("pkg$pkgpart");
- while ( $num_pkgs-- ) {
- push @pkgparts,$pkgpart;
- }
-}
-
-my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums);
-
-if ($error) {
- CGI::Base::SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error updating packages</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error updating packages</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-} else {
- $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg");
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/part_pkg.cgi: Edit package definitions (process form)
-#
-# ivan@sisd.com 97-dec-10
-#
-# don't update non-changing records in part_svc (causing harmless but annoying
-# "Records identical" errors). ivan@sisd.com 98-feb-19
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::part_pkg qw(fields);
-use FS::pkg_svc;
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($pkgpart)=$req->param('pkgpart');
-
-my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart;
-
-my($new)=create FS::part_pkg ( {
- map {
- $_, $req->param($_);
- } fields('part_pkg')
-} );
-
-if ( $pkgpart ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $pkgpart=$new->getfield('pkgpart');
-}
-
-my($part_svc);
-foreach $part_svc (qsearch('part_svc',{})) {
-# don't update non-changing records in part_svc (causing harmless but annoying
-# "Records identical" errors). ivan@sisd.com 98-jan-19
- #my($quantity)=$req->param('pkg_svc'. $part_svc->getfield('svcpart')),
- my($quantity)=$req->param('pkg_svc'. $part_svc->svcpart) || 0,
- my($old_pkg_svc)=qsearchs('pkg_svc',{
- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->getfield('svcpart'),
- });
- my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0;
- next unless $old_quantity != $quantity; #!here
- my($new_pkg_svc)=create FS::pkg_svc({
- 'pkgpart' => $pkgpart,
- 'svcpart' => $part_svc->getfield('svcpart'),
- #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')),
- 'quantity' => $quantity,
- });
- if ($old_pkg_svc) {
- my($error)=$new_pkg_svc->replace($old_pkg_svc);
- eidiot($error) if $error;
- } else {
- my($error)=$new_pkg_svc->insert;
- eidiot($error) if $error;
- }
-}
-
-#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart");
-#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart");
-$req->cgi->redirect("../../browse/part_pkg.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/part_referral.cgi: Edit referrals (process form)
-#
-# ivan@sisd.com 98-feb-23
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::part_referral qw(fields);
-use FS::CGI qw(eidiot);
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($refnum)=$req->param('refnum');
-
-my($new)=create FS::part_referral ( {
- map {
- $_, $req->param($_);
- } fields('part_referral')
-} );
-
-if ( $refnum ) {
- my($old)=qsearchs('part_referral',{'refnum'=>$refnum});
- eidiot("(Old) Record not found!") unless $old;
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
-}
-
-$refnum=$new->getfield('refnum');
-$req->cgi->redirect("../../browse/part_referral.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/part_svc.cgi: Edit service definitions (process form)
-#
-# ivan@sisd.com 97-nov-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::part_svc qw(fields);
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($svcpart)=$req->param('svcpart');
-
-my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart;
-
-my($new)=create FS::part_svc ( {
- map {
- $_, $req->param($_);
-# } qw(svcpart svc svcdb)
- } fields('part_svc')
-} );
-
-if ( $svcpart ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $svcpart=$new->getfield('svcpart');
-}
-
-#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart");
-#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart");
-$req->cgi->redirect("../../browse/part_svc.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_acct.cgi: Add/edit a customer (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_acct.cgi
-#
-# Note: Should br run setuid root as user nobody.
-#
-# ivan@voicenet.com 96-dec-18
-#
-# Changed /u to /u2
-# ivan@voicenet.com 97-may-6
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-17 - 21
-#
-# no FS::Search, FS::svc_acct creates FS::cust_svc record, used for adding
-# and editing ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'password' to '_password' because Pg6.3 reserves the password word
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_acct;
-
-my($req) = new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
-
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
-
-my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum;
-
-#unmunge popnum
-$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] );
-
-#unmunge passwd
-if ( $req->param('_password') eq '*HIDDEN*' ) {
- $req->param('_password',$old->getfield('_password'));
-}
-
-my($new) = create FS::svc_acct ( {
- map {
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir
- shell quota slipip)
-} );
-
-if ( $svcnum ) {
- my($error) = $new->replace($old);
- &idiot($error) if $error;
-} else {
- my($error) = $new->insert;
- &idiot($error) if $error;
- $svcnum = $new->getfield('svcnum');
-}
-
-#no errors, view account
-$req->cgi->redirect("../../view/svc_acct.cgi?" . $svcnum );
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error adding/updating account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error adding/updating account</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
- exit;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_acct_pop.cgi: Edit POP (process form)
-#
-# ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_pop qw(fields);
-use FS::CGI qw(eidiot);
-
-my($req)=new CGI::Request; # create form object
-
-&cgisuidsetup($req->cgi);
-
-my($popnum)=$req->param('popnum');
-
-my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum;
-
-my($new)=create FS::svc_acct_pop ( {
- map {
- $_, $req->param($_);
- } fields('svc_acct_pop')
-} );
-
-if ( $popnum ) {
- my($error)=$new->replace($old);
- eidiot($error) if $error;
-} else {
- my($error)=$new->insert;
- eidiot($error) if $error;
- $popnum=$new->getfield('popnum');
-}
-$req->cgi->redirect("../../browse/svc_acct_pop.cgi");
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_acct_sm.cgi: Add/edit a mail alias (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_acct_sm.cgi
-#
-# Note: Should br run setuid root as user nobody.
-#
-# lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled.
-#
-# ivan@voicenet.com 97-jan-6
-#
-# enabled modifications
-#
-# ivan@voicenet.com 97-may-7
-#
-# fixed removal of cust_svc record on modifications!
-# ivan@voicenet.com 97-jun-5
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_acct_sm;
-
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
-
-my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum;
-
-#unmunge domsvc and domuid
-$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] );
-$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] );
-
-my($new) = create FS::svc_acct_sm ( {
- map {
- ($_, scalar($req->param($_)));
- } qw(svcnum pkgnum svcpart domuser domuid domsvc)
-} );
-
-my($error);
-if ( $svcnum ) {
- $error = $new->replace($old);
-} else {
- $error = $new->insert;
- $svcnum = $new->getfield('svcnum');
-}
-
-unless ($error) {
- $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum");
-} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error adding/editing mail alias</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error adding/editing mail alias</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/svc_domain.cgi: Add a domain (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_domain.cgi
-#
-# Note: Should br run setuid root as user nobody.
-#
-# lots of yucky stuff in this one... bleachlkjhui!
-#
-# ivan@voicenet.com 97-jan-6
-#
-# kludged for new domain template 3.5
-# ivan@voicenet.com 97-jul-24
-#
-# moved internic bits to svc_domain.pm ivan@sisd.com 98-mar-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::svc_domain;
-
-#remove this to actually test the domains!
-$FS::svc_domain::whois_hack = 1;
-
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!";
-my($svcnum)=$1;
-
-my($new) = create FS::svc_domain ( {
- map {
- $_, $req->param($_);
- } qw(svcnum pkgnum svcpart domain action purpose)
-} );
-
-my($error);
-if ($req->param('legal') ne "Yes") {
- $error = "Customer did not agree to be bound by NSI's ".
- qq!<A HREF="http://rs.internic.net/help/agreement.txt">!.
- "Domain Name Resgistration Agreement</A>";
-} elsif ($req->param('svcnum')) {
- $error="Can't modify a domain!";
-} else {
- $error=$new->insert;
- $svcnum=$new->svcnum;
-}
-
-unless ($error) {
- $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum");
-} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error adding domain</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error adding domain</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
-}
-
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct.cgi: Add/edit account (output form)
-#
-# Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
-# http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# ivan@voicenet.com 96-dec-18
-#
-# rewrite ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'password' to '_password' because Pg6.3 reserves the password word
-# bmccane@maxbaud.net 98-apr-3
-#
-# use conf/shells and dbdef username length ivan@sisd.com 98-jul-13
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct qw(fields);
-
-my($shells)="/var/spool/freeside/conf/shells";
-open(SHELLS,$shells) or die "Can't open $shells: $!";
-my(@shells)=map {
- /^([\/\w]*)$/ or die "Illegal shell in conf/shells!";
- $1;
-} grep $_ !~ /^#/, <SHELLS>;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc);
-
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
-
- $svcnum=$1;
- $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct) svcnum!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_acct=create FS::svc_acct({});
-
- foreach $_ (split(/-/,$QUERY_STRING)) {
- $pkgnum=$1 if /^pkgnum(\d+)$/;
- $svcpart=$1 if /^svcpart(\d+)$/;
- }
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $svcnum='';
-
- #set gecos
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- if ($cust_pkg) {
- my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } );
- $svc_acct->setfield('finger',
- $cust_main->getfield('first') . " " . $cust_main->getfield('last')
- ) ;
- }
-
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) {
- $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
- $action="Add";
-
-}
-
-my($svc)=$part_svc->getfield('svc');
-
-my($otaker)=getotaker;
-
-my($username,$password)=(
- $svc_acct->username,
- $svc_acct->_password ? "*HIDDEN*" : '',
-);
-
-my($ulen)=$svc_acct->dbdef_table->column('username')->length;
-my($ulen2)=$ulen+2;
-
-SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>$action $svc account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>$action $svc account</H1>
- </CENTER><HR>
- <FORM ACTION="process/svc_acct.cgi" METHOD=POST>
- <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
- <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
-Username:
-<INPUT TYPE="text" NAME="username" VALUE="$username" SIZE=$ulen2 MAXLENGTH=$ulen>
-<BR>Password:
-<INPUT TYPE="text" NAME="_password" VALUE="$password" SIZE=10 MAXLENGTH=8>
-(blank to generate)
-END
-
-#pop
-my($popnum)=$svc_acct->popnum || 0;
-if ( $part_svc->svc_acct__popnum_flag eq "F" ) {
- print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$popnum">!;
-} else {
- print qq!<BR>POP: <SELECT NAME="popnum" SIZE=1><OPTION>\n!;
- my($svc_acct_pop);
- foreach $svc_acct_pop ( qsearch ('svc_acct_pop',{} ) ) {
- print "<OPTION", $svc_acct_pop->popnum == $popnum ? ' SELECTED' : '', ">",
- $svc_acct_pop->popnum, ": ",
- $svc_acct_pop->city, ", ",
- $svc_acct_pop->state,
- "(", $svc_acct_pop->ac, ")/",
- $svc_acct_pop->exch, "\n"
- ;
- }
- print "</SELECT>";
-}
-
-my($uid,$gid,$finger,$dir)=(
- $svc_acct->uid,
- $svc_acct->gid,
- $svc_acct->finger,
- $svc_acct->dir,
-);
-
-print <<END;
-<INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
-<INPUT TYPE="hidden" NAME="gid" VALUE="$gid">
-<BR>GECOS: <INPUT TYPE="text" NAME="finger" VALUE="$finger">
-<INPUT TYPE="hidden" NAME="dir" VALUE="$dir">
-END
-
-my($shell)=$svc_acct->shell;
-if ( $part_svc->svc_acct__shell_flag eq "F" ) {
- print qq!<INPUT TYPE="hidden" NAME="shell" VALUE="$shell">!;
-} else {
- print qq!<BR>Shell: <SELECT NAME="shell" SIZE=1>!;
- my($etc_shell);
- foreach $etc_shell (@shells) {
- print "<OPTION", $etc_shell eq $shell ? ' SELECTED' : '', ">",
- $etc_shell, "\n";
- }
- print "</SELECT>";
-}
-
-my($quota,$slipip)=(
- $svc_acct->quota,
- $svc_acct->slipip,
-);
-
-print qq!<INPUT TYPE="hidden" NAME="quota" VALUE="$quota">!;
-
-if ( $part_svc->svc_acct__slipip_flag eq "F" ) {
- print qq!<INPUT TYPE="hidden" NAME="slipip" VALUE="$slipip">!;
-} else {
- print qq!<BR>IP: <INPUT TYPE="text" NAME="slipip" VALUE="$slipip">!;
-}
-
-#submit
-print qq!<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_pop.cgi: Add/Edit pop (output form)
-#
-# ivan@sisd.com 98-mar-8
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_pop;
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($svc_acct_pop,$action);
-if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
- $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1});
- $action='Edit';
-} else { #adding
- $svc_acct_pop=create FS::svc_acct_pop {};
- $action='Add';
-}
-my($hashref)=$svc_acct_pop->hashref;
-
-print header("$action POP", menubar(
- 'Main Menu' => '../',
- 'View all POPs' => "../browse/svc_acct_pop.cgi",
-)), <<END;
- <FORM ACTION="process/svc_acct_pop.cgi" METHOD=POST>
-END
-
-#display
-
-print qq!<INPUT TYPE="hidden" NAME="popnum" VALUE="$hashref->{popnum}">!,
- "POP #", $hashref->{popnum} ? $hashref->{popnum} : "(NEW)";
-
-print <<END;
-<PRE>
-City <INPUT TYPE="text" NAME="city" SIZE=32 VALUE="$hashref->{city}">
-State <INPUT TYPE="text" NAME="state" SIZE=3 MAXLENGTH=2 VALUE="$hashref->{state}">
-Area Code <INPUT TYPE="text" NAME="ac" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{ac}">
-Exchange <INPUT TYPE="text" NAME="exch" SIZE=4 MAXLENGTH=3 VALUE="$hashref->{exch}">
-</PRE>
-END
-
-print qq!<BR><INPUT TYPE="submit" VALUE="!,
- $hashref->{popnum} ? "Apply changes" : "Add POP",
- qq!">!;
-
-print <<END;
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_sm.cgi: Add/edit a mail alias (output form)
-#
-# Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
-# http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart}
-#
-# use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# should error out in a more CGI-friendly way, and should have more error checking (sigh).
-#
-# ivan@voicenet.com 97-jan-5
-#
-# added debugging code; fixed CPU-sucking problem with trying to edit an (unaudited) mail alias (no pkgnum)
-#
-# ivan@voicenet.com 97-may-7
-#
-# fixed uid selection
-# ivan@voicenet.com 97-jun-4
-#
-# uid selection across _CUSTOMER_, not just _PACKAGE_
-#
-# ( i need to be rewritten with fast searches)
-#
-# ivan@voicenet.com 97-oct-3
-#
-# added fast searches in some of the places where it is sorely needed...
-# I see DBI::mysql in your future...
-# ivan@voicenet.com 97-oct-23
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_sm qw(fields);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-
-my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc);
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
-
- $svcnum=$1;
- $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum})
- or die "Unknown (svc_acct_sm) svcnum!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_acct_sm=create FS::svc_acct_sm({});
-
- foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart
- $pkgnum=$1 if /^pkgnum(\d+)$/;
- $svcpart=$1 if /^svcpart(\d+)$/;
- }
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $svcnum='';
-
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct_sm') ) {
- if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) {
- $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
- }
- }
-
- $action='Add';
-
-}
-
-my(%username,%domain);
-if ($pkgnum) {
-
- #find all possible uids (and usernames)
-
- my($u_part_svc,@u_acct_svcparts);
- foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
- push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
- }
-
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- my($custnum)=$cust_pkg->getfield('custnum');
- my($i_cust_pkg);
- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
- my($acct_svcpart);
- foreach $acct_svcpart (@u_acct_svcparts) { #now find the corresponding
- #record(s) in cust_svc ( for this
- #pkgnum ! )
- my($i_cust_svc);
- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
- $username{$svc_acct->getfield('uid')}=$svc_acct->getfield('username');
- }
- }
- }
-
- #find all possible domains (and domsvc's)
-
- my($d_part_svc,@d_acct_svcparts);
- foreach $d_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_domain'}) ) {
- push @d_acct_svcparts,$d_part_svc->getfield('svcpart');
- }
-
- foreach $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
- my($cust_pkgnum)=$i_cust_pkg->getfield('pkgnum');
- my($acct_svcpart);
- foreach $acct_svcpart (@d_acct_svcparts) {
- my($i_cust_svc);
- foreach $i_cust_svc ( qsearch('cust_svc',{'pkgnum'=>$cust_pkgnum,'svcpart'=>$acct_svcpart}) ) {
- my($svc_domain)=qsearch('svc_domain',{'svcnum'=>$i_cust_svc->getfield('svcnum')});
- $domain{$svc_domain->getfield('svcnum')}=$svc_domain->getfield('domain');
- }
- }
- }
-
-} elsif ( $action eq 'Edit' ) {
-
- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$svc_acct_sm->domuid});
- $username{$svc_acct_sm->uid} = $svc_acct->username;
-
- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svc_acct_sm->domsvc});
- $domain{$svc_acct_sm->domsvc} = $svc_domain->domain;
-
-} else {
- die "\$action eq Add, but \$pkgnum is null!\n";
-}
-
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias $action</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Mail Alias $action</H1>
- </CENTER>
- <FORM ACTION="process/svc_acct_sm.cgi" METHOD=POST>
-END
-
-#display
-
- #formatting
- print "<PRE>";
-
-#svcnum
-print qq!<INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">!;
-print qq!Service #<FONT SIZE=+1><B>!, $svcnum ? $svcnum : " (NEW)", "</B></FONT>";
-
-#pkgnum
-print qq!<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">!;
-
-#svcpart
-print qq!<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">!;
-
-my($domuser,$domsvc,$domuid)=(
- $svc_acct_sm->domuser,
- $svc_acct_sm->domsvc,
- $svc_acct_sm->domuid,
-);
-
-#domuser
-print qq!\n\nMail to <INPUT TYPE="text" NAME="domuser" VALUE="$domuser"> <I>( * for anything )</I>!;
-
-#domsvc
-print qq! \@ <SELECT NAME="domsvc" SIZE=1>!;
-foreach $_ (keys %domain) {
- print "<OPTION", $_ eq $domsvc ? " SELECTED" : "", ">$_: $domain{$_}";
-}
-print "</SELECT>";
-
-#uid
-print qq!\nforwards to <SELECT NAME="domuid" SIZE=1>!;
-foreach $_ (keys %username) {
- print "<OPTION", ($_ eq $domuid) ? " SELECTED" : "", ">$_: $username{$_}";
-}
-print "</SELECT>\@$mydomain mailbox.";
-
- #formatting
- print "</PRE>\n";
-
-print qq!<CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>!;
-
-print <<END;
-
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_domain.cgi: Add domain (output form)
-#
-# Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart}
-# http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart}
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# ivan@voicenet.com 97-jan-5 -> 97-jan-6
-#
-# changes for domain template 3.5
-# ivan@voicenet.com 97-jul-24
-#
-# rewrite ivan@sisd.com 98-mar-14
-#
-# no GOV in instructions ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup getotaker);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_domain qw(fields);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc);
-
-if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing
-
- $svcnum=$1;
- $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum})
- or die "Unknown (svc_domain) svcnum!";
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum})
- or die "Unknown (cust_svc) svcnum!";
-
- $pkgnum=$cust_svc->pkgnum;
- $svcpart=$cust_svc->svcpart;
-
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $action="Edit";
-
-} else { #adding
-
- $svc_domain=create FS::svc_domain({});
-
- foreach $_ (split(/-/,$QUERY_STRING)) {
- $pkgnum=$1 if /^pkgnum(\d+)$/;
- $svcpart=$1 if /^svcpart(\d+)$/;
- }
- $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart});
- die "No part_svc entry!" unless $part_svc;
-
- $svcnum='';
-
- #set fixed and default fields from part_svc
- my($field);
- foreach $field ( fields('svc_domain') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) {
- $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
- }
- }
-
- $action="Add";
-
-}
-
-my($svc)=$part_svc->getfield('svc');
-
-my($otaker)=getotaker;
-
-my($domain)=(
- $svc_domain->domain,
-);
-
-SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>$action $svc</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>$action $svc</H1>
- </CENTER><HR>
- <FORM ACTION="process/svc_domain.cgi" METHOD=POST>
- <INPUT TYPE="hidden" NAME="svcnum" VALUE="$svcnum">
- <INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
- <INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
- <INPUT TYPE="radio" NAME="action" VALUE="N">New
- <BR><INPUT TYPE="radio" NAME="action" VALUE="M">Transfer
-
-<P>Customer agrees to be bound by NSI's
-<A HREF="http://rs.internic.net/help/agreement.txt">
-Domain Name Registration Agreement</A>
-<SELECT NAME="legal" SIZE=1><OPTION SELECTED>No<OPTION>Yes</SELECT>
-<P>Domain <INPUT TYPE="text" NAME="domain" VALUE="$domain" SIZE=28 MAXLENGTH=26>
-<BR>Purpose/Description: <INPUT TYPE="text" NAME="purpose" VALUE="" SIZE=64>
-<P><CENTER><INPUT TYPE="submit" VALUE="Submit"></CENTER>
-<UL>
- <LI>COM is for commercial, for-profit organziations
- <LI>ORG is for miscellaneous, usually, non-profit organizations
- <LI>NET is for network infrastructure machines and organizations
- <LI>EDU is for 4-year, degree granting institutions
-<!-- <LI>GOV is for United States federal government agencies
-!-->
-</UL>
-US state and local government agencies, schools, libraries, museums, and individuals should register under the US domain. See RFC 1480 for a complete description of the US domain
-and registration procedures.
-<P>GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816).
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>
- Freeside Main Menu
- </TITLE>
- </HEAD>
- <BODY BGCOLOR="#FFFFFF">
- <table>
- <tr><td>
- <P ALIGN=CENTER>
- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.gif">
- </td><td>
- <center><font color="#ff0000" size=7>freeside main menu</font></center>
- </td></tr>
- </table>
- <A HREF="http://www.sisd.com/freeside">
- Information
- </A>
- <BR><A HREF="docs/">
- Documentation
- </A>
- </P>
- <HR>
- <H3><A HREF="edit/cust_main.cgi">New Customer</A></H3>
- <A NAME="search"><H3>Search</H3></A>
- <MENU>
- <LI><A HREF="search/cust_main.html">
- customers (by last name and/or company)
- </A>
- <LI><A HREF="search/cust_main-payinfo.html">customers (by credit card number)</A>
- <LI><A HREF="search/svc_acct.html">accounts (by username)</A>
- <LI><A HREF="search/svc_domain.html">domains (by domain)</A>
- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>
- <LI><A HREF="search/cust_bill.html">invoices (by invoice number)</A>
- </MENU>
- <A NAME="browse"><H3>Browse</H3></A>
- <MENU>
- <LI><A HREF="search/cust_main.cgi?custnum">customers (by customer number)</A>
- <LI><A HREF="search/cust_main.cgi?last">customers (by last name)</A>
- <LI><A HREF="search/cust_main.cgi?company">customers (by company)</A>
- <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
- <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
- <LI><A HREF="search/svc_acct.cgi?svcnum">accounts (by service number)</A>
- <LI><A HREF="search/svc_acct.cgi?username">accounts (by username)</A>
- <LI><A HREF="search/svc_acct.cgi?uid">accounts (by uid)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_svcnum">unlinked accounts (by service number)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_username">unlinked accounts (by username)</A>
- <LI><A HREF="search/svc_acct.cgi?UN_uid">unlinked accounts (by uid)</A>
- <LI><A HREF="search/svc_domain.cgi?svcnum">domains (by service number)</A>
- <LI><A HREF="search/svc_domain.cgi?domain">domains (by domain)</A>
- <LI><A HREF="search/svc_domain.cgi?UN_svcnum">unlinked domains (by service number)</A>
- <LI><A HREF="search/svc_domain.cgi?UN_domain">unlinked domains (by domain)</A>
- </MENU>
- <A NAME="admin"><H3>Administration</H3></a>
- <MENU>
- <LI><A HREF="browse/part_svc.cgi">
- View/Edit services
- </A>
- - Services are items you offer to your customers.
- <LI><A HREF="browse/part_pkg.cgi">
- View/Edit packages
- </A>
- - One or more services are grouped together into a package and
- given pricing information. Customers purchase packages, not
- services.
- <LI><A HREF="browse/agent_type.cgi">
- View/Edit agent types
- </A>
- - Agent types define groups of packages that you can then assign
- to particular agents.
- <LI><A HREF="browse/agent.cgi">
- View/Edit agents
- </A>
- - Agents are resellers of your service. Agents may be limited
- to a subset of your full offerings (via their agent type).
- <BR>
- <LI><A HREF="browse/part_referral.cgi">
- View/Edit referrals
- </A>
- - Where a customer heard about your service. Tracked for
- informational purposes.
- <BR>
- <LI><A HREF="browse/cust_main_county.cgi">
- View/Edit locales and tax rates
- </A>
- - Change tax rates by state, or break down a state into counties
- and assign different tax rates to each county.
- <BR>
- <LI><A HREF="browse/svc_acct_pop.cgi">
- View/Edit POPs
- </A>
- - Points of Presence
- </MENU>
- </FONT>
- </BODY>
-</HTML>
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::Bill;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint custnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-die "Can't find customer!\n" unless $cust_main;
-
-# ?
-bless($cust_main,"FS::Bill");
-
-my($error);
-
-$error = $cust_main->bill(
-# 'time'=>$time
- );
-&idiot($error) if $error;
-
-$error = $cust_main->collect(
-# 'invoice-time'=>$time,
-# 'batch_card'=> 'yes',
- 'batch_card'=> 'no',
- 'report_badcard'=> 'yes',
- );
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error billing customer</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error billing customer</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
- exit;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cancel-unaudited.cgi: Cancel an unaudited account
-#
-# Usage: cancel-unaudited.cgi svcnum
-# http://server.name/path/cancel-unaudited.cgi pkgnum
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# ivan@voicenet.com 97-apr-23
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# Search->Record, cgisuidsetup($cgi) ivan@sids.com 98-mar-19
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_svc;
-use FS::svc_acct;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-
-my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum});
-&idiot("Unknown svcnum!") unless $svc_acct;
-
-my($cust_svc) = qsearchs('cust_svc',{'svcnum'=>$svcnum});
-&idiot(qq!This account has already been audited. Cancel the
- <A HREF="../view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
- qq!pkgnum"> package</A> instead.!)
- if $cust_svc->getfield('pkgnum') ne '';
-
-local $SIG{HUP} = 'IGNORE';
-local $SIG{INT} = 'IGNORE';
-local $SIG{QUIT} = 'IGNORE';
-local $SIG{TERM} = 'IGNORE';
-local $SIG{TSTP} = 'IGNORE';
-
-my($error);
-
-bless($svc_acct,"FS::svc_acct");
-$error = $svc_acct->cancel;
-&idiot($error) if $error;
-$error = $svc_acct->delete;
-&idiot($error) if $error;
-
-bless($cust_svc,"FS::cust_svc");
-$error = $cust_svc->delete;
-&idiot($error) if $error;
-
-$cgi->redirect("../");
-
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error cancelling account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error cancelling account</H1>
- </CENTER>
- <HR>
- There has been an error cancelling this acocunt: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cancel_pkg.cgi: Cancel a package
-#
-# Usage: cancel_pkg.cgi pkgnum
-# http://server.name/path/cancel_pkg.cgi pkgnum
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!!
-#
-# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
-#
-# ivan@voicenet.com 97-jan-2
-#
-# still kludgy, but now runs /dbin/cancel $pkgnum
-# ivan@voicenet.com 97-feb-27
-#
-# doesn't run if pkgnum doesn't match regex
-# ivan@voicenet.com 97-mar-6
-#
-# now redirects to enter comments
-# ivan@voicenet.com 97-may-8
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-use FS::CGI qw(idiot);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->cancel;
-idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# expire_pkg.cgi: Expire a package
-#
-# Usage: post form to:
-# http://server.name/path/expire_pkg.cgi
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# based on susp_pkg
-# ivan@voicenet.com 97-jul-29
-#
-# ivan@sisd.com 98-mar-17 FS::Search->FS::Record
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use Date::Parse;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-
-my($req) = new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-#untaint date & pkgnum
-
-my($date);
-if ( $req->param('date') ) {
- str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date";
- $date=$1;
-} else {
- $date='';
-}
-
-$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-my(%hash)=$cust_pkg->hash;
-$hash{expire}=$date;
-my($new)=create FS::cust_pkg ( \%hash );
-my($error) = $new->replace($cust_pkg);
-&idiot($error) if $error;
-
-$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error expiring package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error expiring package</H1>
- </CENTER>
- <HR>
- There has been an error expiring this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# link: instead of adding a new account, link to an existing. (output form)
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# ivan@voicenet.com 97-feb-5
-#
-# rewrite ivan@sisd.com 98-mar-17
-#
-# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my(%link_field)=(
- 'svc_acct' => 'username',
- 'svc_domain' => 'domain',
- 'svc_acct_sm' => '',
- 'svc_charge' => '',
- 'svc_wo' => '',
-);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-my($pkgnum,$svcpart);
-foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart
- $pkgnum=$1 if /^pkgnum(\d+)$/;
- $svcpart=$1 if /^svcpart(\d+)$/;
-}
-
-my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
-my($svc) = $part_svc->getfield('svc');
-my($svcdb) = $part_svc->getfield('svcdb');
-my($link_field) = $link_field{$svcdb};
-
-CGI::Base::SendHeaders();
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Link to existing $svc account</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Link to existing $svc account</H1>
- </CENTER><HR>
- <FORM ACTION="process/link.cgi" METHOD=POST>
-END
-
-if ( $link_field ) {
- print <<END;
- <INPUT TYPE="hidden" NAME="svcnum" VALUE="">
- <INPUT TYPE="hidden" NAME="link_field" VALUE="$link_field">
- $link_field of existing service: <INPUT TYPE="text" NAME="link_value">
-END
-} else {
- print qq!Service # of existing service: <INPUT TYPE="text" NAME="svcnum" VALUE="">!;
-}
-
-print <<END;
-<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-<INPUT TYPE="hidden" NAME="svcpart" VALUE="$svcpart">
-<P><CENTER><INPUT TYPE="submit" VALUE="Link"></CENTER>
- </FORM>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# just a kludge for now, since this duplicates in a way it shouldn't stuff from
-# Bill.pm (like $lpr) ivan@sisd.com 98-jun-16
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::Invoice;
-
-my($lpr) = "|lpr -h";
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint invnum
-$QUERY_STRING =~ /^(\d*)$/;
-my($invnum)=$1;
-my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum});
-die "Can't find invoice!\n" unless $cust_bill;
-
- bless($cust_bill,"FS::Invoice");
- open(LPR,$lpr) or die "Can't open $lpr: $!";
- print LPR $cust_bill->print_text; #( date )
- close LPR
- or die $! ? "Error closing $lpr: $!"
- : "Exit status $? from $lpr";
-
-my($custnum)=$cust_bill->getfield('custnum');
-
-$cgi->redirect("../view/cust_main.cgi?$custnum#history");
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error printing invoice</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error printing invoice</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- </BODY>
-</HTML>
-END
-
- exit;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/link.cgi: link to existing customer (process form)
-#
-# ivan@voicenet.com 97-feb-5
-#
-# rewrite ivan@sisd.com 98-mar-18
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# can also link on some other fields now (about time) ivan@sisd.com 98-jun-24
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::CGI qw(idiot);
-use FS::UID qw(cgisuidsetup);
-use FS::cust_svc;
-use FS::Record qw(qsearchs);
-
-my($req)=new CGI::Request; # create form object
-cgisuidsetup($req->cgi);
-
-#$req->import_names('R'); #import CGI variables into package 'R';
-
-$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1;
-$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1;
-
-$req->param('svcnum') =~ /^(\d*)$/; my($svcnum)=$1;
-unless ( $svcnum ) {
- my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart});
- my($svcdb) = $part_svc->getfield('svcdb');
- $req->param('link_field') =~ /^(\w+)$/; my($link_field)=$1;
- my($svc_acct)=qsearchs($svcdb,{$link_field => $req->param('link_value') });
- idiot("$link_field not found!") unless $svc_acct;
- $svcnum=$svc_acct->svcnum;
-}
-
-my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-die "svcnum not found!" unless $old;
-my($new)=create FS::cust_svc ({
- 'svcnum' => $svcnum,
- 'pkgnum' => $pkgnum,
- 'svcpart' => $svcpart,
-});
-
-my($error);
-$error = $new->replace($old);
-
-unless ($error) {
- #no errors, so let's view this customer.
- $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum");
-} else {
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error</H4>
- </CENTER>
- Your update did not occur because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and submit the form again.
- </BODY>
-</HTML>
-END
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# susp_pkg.cgi: Suspend a package
-#
-# Usage: susp_pkg.cgi pkgnum
-# http://server.name/path/susp_pkg.cgi pkgnum
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
-#
-# ivan@voicenet.com 97-feb-27
-#
-# now redirects to enter comments
-# ivan@voicenet.com 97-may-8
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->suspend;
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error suspending package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error suspending package</H1>
- </CENTER>
- <HR>
- There has been an error suspending this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# susp_pkg.cgi: Unsuspend a package
-#
-# Usage: susp_pkg.cgi pkgnum
-# http://server.name/path/susp_pkg.cgi pkgnum
-#
-# Note: Should be run setuid freeside as user nobody
-#
-# probably should generalize this to do cancels, suspensions, unsuspensions, etc.
-#
-# ivan@voicenet.com 97-feb-27
-#
-# now redirects to enter comments
-# ivan@voicenet.com 97-may-8
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-21
-#
-# FS::Search -> FS::Record ivan@sisd.com 98-mar-17
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::cust_pkg;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum";
-my($pkgnum)=$1;
-
-my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-
-bless($cust_pkg,'FS::cust_pkg');
-my($error)=$cust_pkg->unsuspend;
-&idiot($error) if $error;
-
-$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum'));
-
-sub idiot {
- my($error)=@_;
- SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error unsuspending package</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Error unsuspending package</H1>
- </CENTER>
- <HR>
- There has been an error unsuspending this package: $error
- </BODY>
- </HEAD>
-</HTML>
-END
- exit;
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_bill.cgi: Search for invoices (process form)
-#
-# Usage: post form to:
-# http://server.name/path/cust_bill.cgi
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 97-apr-4
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my($req)=new CGI::Request;
-cgisuidsetup($req->cgi);
-
-$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/;
-my($invnum)=$2;
-
-if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) {
- $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect
-} else { #error
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Invoice Search Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H3>Invoice Search Error</H3>
- <HR>
- Invoice not found.
- </CENTER>
- </BODY>
-</HTML>
-END
-
-}
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Invoice Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Invoice Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="cust_bill.cgi" METHOD="post">
- Search for <B>invoice #</B>:
- <INPUT TYPE="text" NAME="invnum">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
- </BODY>
-</HTML>
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Customer Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="cust_main.cgi" METHOD="post">
- Search for <B>Credit card #</B>:
- <INPUT TYPE="hidden" NAME="card_on" VALUE="TRUE">
- <INPUT TYPE="text" NAME="card">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
- <HR>
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# process/cust_main.cgi: Search for customers (process form)
-#
-# Usage: post form to:
-# http://server.name/path/cust_main.cgi
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 96-dec-12
-#
-# rewrite ivan@sisd.com 98-mar-4
-#
-# now does browsing too ivan@sisd.com 98-mar-6
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# display total, use FS::CGI ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use IO::Handle;
-use IPC::Open2;
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
-
-my($fuzziness)=2; #fuzziness for fuzzy searches, see man agrep
- #0-4: 0=no fuzz, 4=very fuzzy (too much fuzz!)
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-my(@cust_main);
-my($sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-if ( $query eq 'custnum' ) {
- $sortby=\*custnum_sort;
- @cust_main=qsearch('cust_main',{});
-} elsif ( $query eq 'last' ) {
- $sortby=\*last_sort;
- @cust_main=qsearch('cust_main',{});
-} elsif ( $query eq 'company' ) {
- $sortby=\*company_sort;
- @cust_main=qsearch('cust_main',{});
-} else {
- &cardsearch if ($req->param('card_on') );
- &lastsearch if ($req->param('last_on') );
- &companysearch if ($req->param('company_on') );
-}
-
-if ( scalar(@cust_main) == 1 ) {
- $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum);
- exit;
-} elsif ( scalar(@cust_main) == 0 ) {
- idiot "No matching customers found!\n";
- exit;
-} else {
-
- my($total)=scalar(@cust_main);
- CGI::Base::SendHeaders(); # one guess
- print header("Customer Search Results",''), <<END;
-
- $total matching customers found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Cust. #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$cust_main);
- foreach $cust_main (
- sort $sortby grep(!$saw{$_->custnum}++, @cust_main)
- ) {
- my($custnum,$last,$first,$company)=(
- $cust_main->custnum,
- $cust_main->getfield('last'),
- $cust_main->getfield('first'),
- $cust_main->company,
- );
- print <<END;
- <TR>
- <TD><A HREF="../view/cust_main.cgi?$custnum"><FONT SIZE=-1>$custnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$last, $first</FONT></TD>
- <TD><FONT SIZE=-1>$company</FONT></TD>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Cust. #</TH>
- <TH>Contact name</TH>
- <TH>Company<TH>
- </TR>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
-}
-
-#
-
-sub last_sort {
- $a->getfield('last') cmp $b->getfield('last');
-}
-
-sub company_sort {
- $a->getfield('company') cmp $b->getfield('company');
-}
-
-sub custnum_sort {
- $a->getfield('custnum') <=> $b->getfield('custnum');
-}
-
-sub cardsearch {
-
- my($card)=$req->param('card');
- $card =~ s/\D//g;
- $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; };
- my($payinfo)=$1;
-
- push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'});
-
-}
-
-sub lastsearch {
- my(%last_type);
- foreach ( $req->param('last_type') ) {
- $last_type{$_}++;
- }
-
- $req->param('last_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal last name"; exit; };
- my($last)=$1;
-
- if ( $last_type{'Exact'}
- && ! $last_type{'Fuzzy'}
- # && ! $last_type{'Sound-alike'}
- ) {
-
- push @cust_main, qsearch('cust_main',{'last'=>$last});
-
- } else {
-
- my(%last);
-
- my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{});
- if ($last_type{'Fuzzy'}) {
- my($reader,$writer) = ( new IO::Handle, new IO::Handle );
- open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k',
- substr($last,0,30));
- print $writer join("\n",@all_last),"\n";
- close $writer;
- while (<$reader>) {
- chop;
- $last{$_}++;
- }
- close $reader;
- }
-
- #if ($last_type{'Sound-alike'}) {
- #}
-
- foreach ( keys %last ) {
- push @cust_main, qsearch('cust_main',{'last'=>$_});
- }
-
- }
- $sortby=\*last_sort;
-}
-
-sub companysearch {
-
- my(%company_type);
- foreach ( $req->param('company_type') ) {
- $company_type{$_}++
- };
-
- $req->param('company_text') =~ /^([\w \,\.\-\']*)$/
- or do { idiot "Illegal company"; exit; };
- my($company)=$1;
-
- if ( $company_type{'Exact'}
- && ! $company_type{'Fuzzy'}
- # && ! $company_type{'Sound-alike'}
- ) {
-
- push @cust_main, qsearch('cust_main',{'company'=>$company});
-
- } else {
-
- my(%company);
- my(@all_company)=map $_->company, qsearch('cust_main',{});
-
- if ($company_type{'Fuzzy'}) {
- my($reader,$writer) = ( new IO::Handle, new IO::Handle );
- open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k',
- substr($company,0,30));
- print $writer join("\n",@all_company),"\n";
- close $writer;
- while (<$reader>) {
- chop;
- $company{$_}++;
- }
- close $reader;
- }
-
- #if ($company_type{'Sound-alike'}) {
- #}
-
- foreach ( keys %company ) {
- push @cust_main, qsearch('cust_main',{'company'=>$_});
- }
-
- }
- $sortby=\*company_sort;
-
-}
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Customer Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Customer Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="cust_main.cgi" METHOD="post">
- <INPUT TYPE="checkbox" NAME="last_on"> Search for <B>last name</B>:
- <INPUT TYPE="text" NAME="last_text">
- using search method(s): <SELECT NAME="last_type" MULTIPLE>
- <OPTION SELECTED>Fuzzy
- <OPTION>Exact
- </SELECT>
-
- <P><INPUT TYPE="checkbox" NAME="company_on"> Search for <B>company</B>:
- <INPUT TYPE="text" NAME="company_text">
- using search methods(s): <SELECT NAME="company_type" MULTIPLE>
- <OPTION SELECTED>Fuzzy
- <OPTION>Exact
- </SELECT>
-
- <P><INPUT TYPE="submit" VALUE="Search"> Note: Fuzzy searching can take a while. Please be patient.
-
- </FORM>
-
- <HR>Explanation of search methods:
- <UL>
- <LI><B>Fuzzy</B> - Searches for matches that are close to your text.
- <LI><B>Exact</B> - Finds exact matches only, but much faster than the other search methods.
- </UL>
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pkg.cgi: search/browse for packages
-#
-# based on search/svc_acct.cgi ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-my(@cust_pkg,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-#this tree is a little bit redundant
-if ( $query eq 'pkgnum' ) {
- $sortby=\*pkgnum_sort;
- @cust_pkg=qsearch('cust_pkg',{});
-} elsif ( $query eq 'APKG_pkgnum' ) {
- $sortby=\*pkgnum_sort;
-
- #perhaps this should go in cust_pkg as a qsearch-like constructor?
- my($cust_pkg);
- foreach $cust_pkg (qsearch('cust_pkg',{})) {
- my($flag)=0;
- my($pkg_svc);
- PKG_SVC:
- foreach $pkg_svc (qsearch('pkg_svc',{ 'pkgpart' => $cust_pkg->pkgpart })) {
- if ( $pkg_svc->quantity
- > scalar(qsearch('cust_svc',{
- 'pkgnum' => $cust_pkg->pkgnum,
- 'svcpart' => $pkg_svc->svcpart,
- }))
- )
- {
- $flag=1;
- last PKG_SVC;
- }
- }
- push @cust_pkg, $cust_pkg if $flag;
- }
-} else {
- die "Empty QUERY_STRING!";
-}
-
-if ( scalar(@cust_pkg) == 1 ) {
- my($pkgnum)=$cust_pkg[0]->pkgnum;
- $req->cgi->redirect("../view/cust_pkg.cgi?$pkgnum");
- exit;
-} elsif ( scalar(@cust_pkg) == 0 ) { #error
- &idiot("No packages found");
- exit;
-} else {
- my($total)=scalar(@cust_pkg);
- CGI::Base::SendHeaders(); # one guess
- print header('Package Search Results',''), <<END;
- $total matching packages found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Package #</TH>
- <TH>Customer #</TH>
- <TH>Name</TH>
- <TH>Company</TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$cust_pkg);
- foreach $cust_pkg (
- sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg)
- ) {
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
- my($pkgnum,$custnum,$name,$company)=(
- $cust_pkg->pkgnum,
- $cust_main->custnum,
- $cust_main->last. ', '. $cust_main->first,
- $cust_main->company,
- );
- print <<END;
- <TR>
- <TD><A HREF="../view/cust_pkg.cgi?$pkgnum"><FONT SIZE=-1>$pkgnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$custnum</FONT></TD>
- <TD><FONT SIZE=-1>$name</FONT></TD>
- <TD><FONT SIZE=-1>$company</FONT></TD>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Package #</TH>
- <TH>Customer #</TH>
- <TH>Name</TH>
- <TH>Company</TH>
- <TH>
- </TR>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
- exit;
-
-}
-
-sub pkgnum_sort {
- $a->getfield('pkgnum') <=> $b->getfield('pkgnum');
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct.cgi: Search for customers (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_acct.cgi
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# loosely (sp?) based on search/cust_main.cgi
-#
-# ivan@voicenet.com 96-jan-3 -> 96-jan-4
-#
-# rewrite (now does browsing too) ivan@sisd.com 98-mar-9
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# show unlinked accounts ivan@sisd.com 98-jun-22
-#
-# use FS::CGI, show total ivan@sisd.com 98-jul-17
-#
-# give service and customer info too ivan@sisd.com 98-aug-16
-
-use strict;
-use CGI::Request; # form processing module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
-
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
-
-my(@svc_acct,$sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-#this tree is a little bit redundant
-if ( $query eq 'svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_acct=qsearch('svc_acct',{});
-} elsif ( $query eq 'username' ) {
- $sortby=\*username_sort;
- @svc_acct=qsearch('svc_acct',{});
-} elsif ( $query eq 'uid' ) {
- $sortby=\*uid_sort;
- @svc_acct=grep $_->uid ne '', qsearch('svc_acct',{});
-} elsif ( $query eq 'UN_svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_acct = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_acct',{});
-} elsif ( $query eq 'UN_username' ) {
- $sortby=\*username_sort;
- @svc_acct = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_acct',{});
-} elsif ( $query eq 'UN_uid' ) {
- $sortby=\*uid_sort;
- @svc_acct = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_acct',{});
-} else {
- &usernamesearch;
-}
-
-if ( scalar(@svc_acct) == 1 ) {
- my($svcnum)=$svc_acct[0]->svcnum;
- $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect
- exit;
-} elsif ( scalar(@svc_acct) == 0 ) { #error
- idiot("Account not found");
- exit;
-} else {
- my($total)=scalar(@svc_acct);
- CGI::Base::SendHeaders(); # one guess
- print header("Account Search Results",''), <<END;
- $total matching accounts found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Username</TH>
- <TH>UID</TH>
- <TH>Service</TH>
- <TH>Customer #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$svc_acct);
- foreach $svc_acct (
- sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct)
- ) {
- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct->svcnum })
- or die "No cust_svc record for svcnum ". $svc_acct->svcnum;
- my $part_svc = qsearchs('part_svc', { 'svcpart' => $cust_svc->svcpart })
- or die "No part_svc record for svcpart ". $cust_svc->svcpart;
- my($cust_pkg,$cust_main);
- if ( $cust_svc->pkgnum ) {
- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc->pkgnum })
- or die "No cust_pkg record for pkgnum ". $cust_svc->pkgnum;
- $cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg->custnum })
- or die "No cust_main record for custnum ". $cust_pkg->custnum;
- }
- my($svcnum,$username,$uid,$svc,$custnum,$last,$first,$company)=(
- $svc_acct->svcnum,
- $svc_acct->getfield('username'),
- $svc_acct->getfield('uid'),
- $part_svc->svc,
- $cust_svc->pkgnum ? $cust_main->custnum : '',
- $cust_svc->pkgnum ? $cust_main->getfield('last') : '',
- $cust_svc->pkgnum ? $cust_main->getfield('first') : '',
- $cust_svc->pkgnum ? $cust_main->company : '',
- );
- my($pcustnum) = $custnum
- ? "<A HREF=\"../view/cust_main.cgi?$custnum\"><FONT SIZE=-1>$custnum</FONT></A>"
- : "<I>(unlinked)</I>"
- ;
- my($pname) = $custnum ? "$last, $first" : '';
- print <<END;
- <TR>
- <TD><A HREF="../view/svc_acct.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$username</FONT></TD>
- <TD><FONT SIZE=-1>$uid</FONT></TD>
- <TD><FONT SIZE=-1>$svc</FONT></TH>
- <TD><FONT SIZE=-1>$pcustnum</FONT></TH>
- <TD><FONT SIZE=-1>$pname<FONT></TH>
- <TD><FONT SIZE=-1>$company</FONT></TH>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Userame</TH>
- <TH>UID</TH>
- <TH>Service</TH>
- <TH>Customer #</TH>
- <TH>Contact name</TH>
- <TH>Company</TH>
- </TR>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
- exit;
-
-}
-
-sub svcnum_sort {
- $a->getfield('svcnum') <=> $b->getfield('svcnum');
-}
-
-sub username_sort {
- $a->getfield('username') cmp $b->getfield('username');
-}
-
-sub uid_sort {
- $a->getfield('uid') <=> $b->getfield('uid');
-}
-
-sub usernamesearch {
-
- $req->param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text
- my($username)=$1;
-
- @svc_acct=qsearch('svc_acct',{'username'=>$username});
-
-}
-
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Account Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Account Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="svc_acct.cgi" METHOD="post">
- Search for <B>username</B>:
- <INPUT TYPE="text" NAME="username">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_acct_sm.cgi: Search for domains (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_domain.cgi
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 96-mar-5
-#
-# need to look at table in results to make it more readable
-#
-# ivan@voicenet.com
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
-
-my($req)=new CGI::Request; # create form object
-&cgisuidsetup($req->cgi);
-
-$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/;
-my($domuser)=$1;
-
-$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain";
-my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1})
- or die "Unknown domain";
-my($domsvc)=$svc_domain->svcnum;
-
-my(@svc_acct_sm);
-if ($domuser) {
- @svc_acct_sm=qsearch('svc_acct_sm',{
- 'domuser' => $domuser,
- 'domsvc' => $domsvc,
- });
-} else {
- @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $domsvc});
-}
-
-if ( scalar(@svc_acct_sm) == 1 ) {
- my($svcnum)=$svc_acct_sm[0]->svcnum;
- $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect
-} elsif ( scalar(@svc_acct_sm) > 1 ) {
- CGI::Base::SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias Search Results</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Mail Alias Search Results</H4>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Mail to<BR><FONT SIZE=-2>(click here to view mail alias)</FONT></TH>
- <TH>Forwards to<BR><FONT SIZE=-2>(click here to view account)</FONT></TH>
- </TR>
-END
-
- my($svc_acct_sm);
- foreach $svc_acct_sm (@svc_acct_sm) {
- my($svcnum,$domuser,$domuid,$domsvc)=(
- $svc_acct_sm->svcnum,
- $svc_acct_sm->domuser,
- $svc_acct_sm->domuid,
- $svc_acct_sm->domsvc,
- );
- my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
- my($domain)=$svc_domain->domain;
- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
- my($username)=$svc_acct->username;
- my($svc_acct_svcnum)=$svc_acct->svcnum;
-
- print <<END;
-<TR>\n <TD> <A HREF="../view/svc_acct_sm.cgi?$svcnum">
-END
-
- print '', ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser );
-
- print <<END;
-\@$domain</A> </TD>\n
-<TD> <A HREF="../view/svc_acct.cgi?$svc_acct_svcnum">$username\@$mydomain</A> </TD>\n </TR>\n
-END
-
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
-} else { #error
- CGI::Base::SendHeaders(); # one guess
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias Search Error</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H3>Mail Alias Search Error</H3>
- <HR>
- Mail Alias not found.
- </CENTER>
- </BODY>
-</HTML>
-END
-
-}
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Mail Alias Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Mail Alias Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="svc_acct_sm.cgi" METHOD="post">
- Search for <B>mail alias</B>:
- <INPUT TYPE="text" NAME="domuser"><FONT SIZE=-1>(opt.)</FONT> @
- <INPUT TYPE="text" NAME="domain"><FONT SIZE=-1>(req.)</FONT>
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
-
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# svc_domain.cgi: Search for domains (process form)
-#
-# Usage: post form to:
-# http://server.name/path/svc_domain.cgi
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 97-mar-5
-#
-# rewrite ivan@sisd.com 98-mar-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Request;
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::CGI qw(header idiot);
-
-my($req)=new CGI::Request;
-&cgisuidsetup($req->cgi);
-
-my(@svc_domain);
-my($sortby);
-
-my($query)=$req->cgi->var('QUERY_STRING');
-if ( $query eq 'svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_domain=qsearch('svc_domain',{});
-} elsif ( $query eq 'domain' ) {
- $sortby=\*domain_sort;
- @svc_domain=qsearch('svc_domain',{});
-} elsif ( $query eq 'UN_svcnum' ) {
- $sortby=\*svcnum_sort;
- @svc_domain = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_domain',{});
-} elsif ( $query eq 'UN_domain' ) {
- $sortby=\*domain_sort;
- @svc_domain = grep qsearchs('cust_svc',{
- 'svcnum' => $_->svcnum,
- 'pkgnum' => '',
- }), qsearch('svc_domain',{});
-} else {
- $req->param('domain') =~ /^([\w\-\.]+)$/;
- my($domain)=$1;
- push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain});
-}
-
-if ( scalar(@svc_domain) == 1 ) {
- $req->cgi->redirect("../view/svc_domain.cgi?". $svc_domain[0]->svcnum);
- exit;
-} elsif ( scalar(@svc_domain) == 0 ) {
- idiot "No matching domains found!\n";
- exit;
-} else {
- CGI::Base::SendHeaders(); # one guess
-
- my($total)=scalar(@svc_domain);
- CGI::Base::SendHeaders(); # one guess
- print header("Domain Search Results",''), <<END;
-
- $total matching domains found
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Domain</TH>
- <TH></TH>
- </TR>
-END
-
- my($lines)=16;
- my($lcount)=$lines;
- my(%saw,$svc_domain);
- foreach $svc_domain (
- sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain)
- ) {
- my($svcnum,$domain)=(
- $svc_domain->svcnum,
- $svc_domain->domain,
- );
- my($malias);
- if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) {
- $malias=(
- qq|<FORM ACTION="svc_acct_sm.cgi" METHOD="post">|.
- qq|<INPUT TYPE="hidden" NAME="domuser" VALUE="">|.
- qq|<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">|.
- qq|<INPUT TYPE="submit" VALUE="(mail aliases)">|.
- qq|</FORM>|
- );
- } else {
- $malias='';
- }
- print <<END;
- <TR>
- <TD><A HREF="../view/svc_domain.cgi?$svcnum"><FONT SIZE=-1>$svcnum</FONT></A></TD>
- <TD><FONT SIZE=-1>$domain</FONT></TD>
- <TD><FONT SIZE=-1>$malias</FONT></TD>
- </TR>
-END
- if ($lcount-- == 0) { # lots of little tables instead of one big one
- $lcount=$lines;
- print <<END;
- </TABLE>
- <TABLE BORDER=4 CELLSPACING=0 CELLPADDING=0>
- <TR>
- <TH>Service #</TH>
- <TH>Domain</TH>
- <TH></TH>
- </TR>
-END
- }
- }
-
- print <<END;
- </TABLE>
- </CENTER>
- </BODY>
-</HTML>
-END
-
-}
-
-sub svcnum_sort {
- $a->getfield('svcnum') <=> $b->getfield('svcnum');
-}
-
-sub domain_sort {
- $a->getfield('domain') cmp $b->getfield('doimain');
-}
-
-
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>Domain Search</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Domain Search</H1>
- </CENTER>
- <HR>
- <FORM ACTION="svc_domain.cgi" METHOD="post">
- Search for <B>domain</B>:
- <INPUT TYPE="text" NAME="domain">
-
- <P><INPUT TYPE="submit" VALUE="Search">
-
- </FORM>
-
- <HR>
-
- </BODY>
-</HTML>
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# Usage: cust_bill.cgi invnum
-# http://server.name/path/cust_bill.cgi?invnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice
-#
-# ivan@voicenet.com 96-dec-05
-#
-# added navigation bar
-# ivan@voicenet.com 97-jan-30
-#
-# now uses Invoice.pm
-# ivan@voicenet.com 97-jun-30
-#
-# what to do if cust_bill search errors?
-# ivan@voicenet.com 97-jul-7
-#
-# s/FS::Search/FS::Record/; $cgisuidsetup($cgi); ivan@sisd.com 98-mar-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# also print 'printed' field ivan@sisd.com 98-jul-10
-
-use strict;
-use IO::File;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-use FS::Invoice;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint invnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($invnum)=$1;
-
-my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum});
-die "Invoice #$invnum not found!" unless $cust_bill;
-my($custnum) = $cust_bill->getfield('custnum');
-
-my($printed) = $cust_bill->printed;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Invoice View</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Invoice View</H1>
- <A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> | <A HREF="../">Main menu</A>
- </CENTER><HR>
- <BASEFONT SIZE=3>
- <CENTER>
- <A HREF="../edit/cust_pay.cgi?$invnum">Enter payments (check/cash) against this invoice</A>
- <BR><A HREF="../misc/print-invoice.cgi?$invnum">Reprint this invoice</A>
- <BR><BR>(Printed $printed times)
- </CENTER>
- <FONT SIZE=-1><PRE>
-END
-
-bless($cust_bill,"FS::Invoice");
-print $cust_bill->print_text;
-
- #formatting
- print <<END;
- </PRE></FONT>
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_main.cgi: View a customer
-#
-# Usage: cust_main.cgi custnum
-# http://server.name/path/cust_main.cgi?custnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# the payment history section could use some work, see below
-#
-# ivan@voicenet.com 96-nov-29 -> 96-dec-11
-#
-# added navigation bar (go to main menu ;)
-# ivan@voicenet.com 97-jan-30
-#
-# changes to the way credits/payments are applied (the links are here).
-# ivan@voicenet.com 97-apr-21
-#
-# added debugging code to diagnose CPU sucking problem.
-# ivan@voicenet.com 97-may-19
-#
-# CPU sucking problem was in comment code? fixed?
-# ivan@voicenet.com 97-may-22
-#
-# rewrote for new API
-# ivan@voicenet.com 97-jul-22
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'day' to 'daytime' because Pg6.3 reserves the day word
-# bmccane@maxbaud.net 98-apr-3
-#
-# lose background, FS::CGI ivan@sisd.com 98-sep-2
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use CGI::Carp qw(fatalsToBrowser);
-use Date::Format;
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs qsearch);
-use FS::CGI qw(header menubar);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-SendHeaders(); # one guess.
-print header("Customer View", menubar(
- 'Main Menu' => '../',
-)),<<END;
- <BASEFONT SIZE=3>
-END
-
-#untaint custnum & get customer record
-$QUERY_STRING =~ /^(\d+)$/;
-my($custnum)=$1;
-my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
-die "Customer not found!" unless $cust_main;
-my($hashref)=$cust_main->hashref;
-
-#custnum
-print "<FONT SIZE=+1><CENTER>Customer #<B>$custnum</B></CENTER></FONT>",
- qq!<CENTER><A HREF="#cust_main">Customer Information</A> | !,
- qq!<A HREF="#cust_comments">Comments</A> | !,
- qq!<A HREF="#cust_pkg">Packages</A> | !,
- qq!<A HREF="#history">Payment History</A> </CENTER>!;
-
-#bill now linke
-print qq!<HR><CENTER><A HREF="../misc/bill.cgi?$custnum">!,
- qq!Bill this customer now</A></CENTER>!;
-
-#formatting
-print qq!<HR><A NAME="cust_main"><CENTER><FONT SIZE=+1>Customer Information!,
- qq!</FONT>!,
- qq!<BR><A HREF="../edit/cust_main.cgi?$custnum!,
- qq!">Edit this information</A></CENTER><FONT SIZE=-1>!;
-
-#agentnum
-my($agent)=qsearchs('agent',{
- 'agentnum' => $cust_main->getfield('agentnum')
-} );
-die "Agent not found!" unless $agent;
-print "<BR>Agent #<B>" , $agent->getfield('agentnum') , ": " ,
- $agent->getfield('agent') , "</B>";
-
-#refnum
-my($referral)=qsearchs('part_referral',{'refnum' => $cust_main->refnum});
-die "Referral not found!" unless $referral;
-print "<BR>Referral #<B>", $referral->refnum, ": ",
- $referral->referral, "<\B>";
-
-#last, first
-print "<P><B>", $hashref->{'last'}, ", ", $hashref->{first}, "</B>";
-
-#ss
-print " (SS# <B>", $hashref->{ss}, "</B>)" if $hashref->{ss};
-
-#company
-print "<BR><B>", $hashref->{company}, "</B>" if $hashref->{company};
-
-#address1
-print "<BR><B>", $hashref->{address1}, "</B>";
-
-#address2
-print "<BR><B>", $hashref->{address2}, "</B>" if $hashref->{address2};
-
-#city
-print "<BR><B>", $hashref->{city}, "</B>";
-
-#county
-print " (<B>", $hashref->{county}, "</B> county)" if $hashref->{county};
-
-#state
-print ",<B>", $hashref->{state}, "</B>";
-
-#zip
-print " <B>", $hashref->{zip}, "</B>";
-
-#country
-print "<BR><B>", $hashref->{country}, "</B>"
- unless $hashref->{country} eq "US";
-
-#daytime
-print "<P><B>", $hashref->{daytime}, "</B>" if $hashref->{daytime};
-print " (Day)" if $hashref->{daytime} && $hashref->{night};
-
-#night
-print "<BR><B>", $hashref->{night}, "</B>" if $hashref->{night};
-print " (Night)" if $hashref->{daytime} && $hashref->{night};
-
-#fax
-print "<BR><B>", $hashref->{fax}, "</B> (Fax)" if $hashref->{fax};
-
-#payby/payinfo/paydate/payname
-if ($hashref->{payby} eq "CARD") {
- print "<P>Card #<B>", $hashref->{payinfo}, "</B> Exp. <B>",
- $hashref->{paydate}, "</B>";
- print " (<B>", $hashref->{payname}, "</B>)" if $hashref->{payname};
-} elsif ($hashref->{payby} eq "BILL") {
- print "<P>Bill";
- print " on P.O. #<B>", $hashref->{payinfo}, "</B>"
- if $hashref->{payinfo};
- print " until <B>", $hashref->{paydate}, "</B>"
- if $hashref->{paydate};
- print " to <B>", $hashref->{payname}, "</B> at above address"
- if $hashref->{payname};
-} elsif ($hashref->{payby} eq "COMP") {
- print "<P>Access complimentary";
- print " courtesy of <B>", $hashref->{payinfo}, "</B>"
- if $hashref->{payinfo};
- print " until <B>", $hashref->{paydate}, "</B>"
- if $hashref->{paydate};
-} else {
- print "Unknown payment type ", $hashref->{payby}, "!";
-}
-
-#tax
-print "<BR>(Tax exempt)" if $hashref->{tax};
-
-#otaker
-print "<P>Order taken by <B>", $hashref->{otaker}, "</B>";
-
-#formatting
-print qq!<HR><FONT SIZE=+1><A NAME="cust_pkg"><CENTER>Packages</A></FONT>!,
- qq!<BR>Click on package number to view/edit package.!,
- qq!<BR><A HREF="../edit/cust_pkg.cgi?$custnum">Add/Edit packages</A>!,
- qq!</CENTER><BR>!;
-
-#display packages
-
-#formatting
-print qq!<CENTER><TABLE BORDER=4>\n!,
- qq!<TR><TH ROWSPAN=2>#</TH><TH ROWSPAN=2>Package</TH><TH COLSPAN=5>!,
- qq!Dates</TH></TR>\n!,
- qq!<TR><TH><FONT SIZE=-1>Setup</FONT></TH><TH>!,
- qq!<FONT SIZE=-1>Next bill</FONT>!,
- qq!</TH><TH><FONT SIZE=-1>Susp.</FONT></TH><TH><FONT SIZE=-1>Expire!,
- qq!</FONT></TH>!,
- qq!<TH><FONT SIZE=-1>Cancel</FONT></TH>!,
- qq!</TR>\n!;
-
-#get package info
-my(@packages)=qsearch('cust_pkg',{'custnum'=>$custnum});
-my($package);
-foreach $package (@packages) {
- my($pref)=$package->hashref;
- my($part_pkg)=qsearchs('part_pkg',{
- 'pkgpart' => $pref->{pkgpart}
- } );
- print qq!<TR><TD><FONT SIZE=-1><A HREF="../view/cust_pkg.cgi?!,
- $pref->{pkgnum}, qq!">!,
- $pref->{pkgnum}, qq!</A></FONT></TD>!,
- "<TD><FONT SIZE=-1>", $part_pkg->getfield('pkg'), " - ",
- $part_pkg->getfield('comment'), "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{setup} ? time2str("%D",$pref->{setup} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{bill} ? time2str("%D",$pref->{bill} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{susp} ? time2str("%D",$pref->{susp} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{expire} ? time2str("%D",$pref->{expire} ) : "" ,
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- $pref->{cancel} ? time2str("%D",$pref->{cancel} ) : "" ,
- "</FONT></TD>",
- "</TR>";
-}
-
-#formatting
-print "</TABLE></CENTER>";
-
-#formatting
-print qq!<CENTER><HR><A NAME="history"><FONT SIZE=+1>Payment History!,
- qq!</FONT></A><BR>!,
- qq!Click on invoice to view invoice/enter payment.<BR>!,
- qq!<A HREF="../edit/cust_credit.cgi?$custnum">!,
- qq!Post Credit / Refund</A></CENTER><BR>!;
-
-#get payment history
-#
-# major problem: this whole thing is way too sloppy.
-# minor problem: the description lines need better formatting.
-
-my(@history);
-
-my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum});
-my($bill);
-foreach $bill (@bills) {
- my($bref)=$bill->hashref;
- push @history,
- $bref->{_date} . qq!\t<A HREF="../view/cust_bill.cgi?! .
- $bref->{invnum} . qq!">Invoice #! . $bref->{invnum} .
- qq! (Balance \$! . $bref->{owed} . qq!)</A>\t! .
- $bref->{charged} . qq!\t\t\t!;
-
- my(@payments)=qsearch('cust_pay',{'invnum'=> $bref->{invnum} } );
- my($payment);
- foreach $payment (@payments) {
-# my($pref)=$payment->hashref;
- my($date,$invnum,$payby,$payinfo,$paid)=($payment->getfield('_date'),
- $payment->getfield('invnum'),
- $payment->getfield('payby'),
- $payment->getfield('payinfo'),
- $payment->getfield('paid'),
- );
- push @history,
- "$date\tPayment, Invoice #$invnum ($payby $payinfo)\t\t$paid\t\t";
- }
-}
-
-my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum});
-my($credit);
-foreach $credit (@credits) {
- my($cref)=$credit->hashref;
- push @history,
- $cref->{_date} . "\tCredit #" . $cref->{crednum} . ", (Balance \$" .
- $cref->{credited} . ") by " . $cref->{otaker} . " - " .
- $cref->{reason} . "\t\t\t" . $cref->{amount} . "\t";
-
- my(@refunds)=qsearch('cust_refund',{'crednum'=> $cref->{crednum} } );
- my($refund);
- foreach $refund (@refunds) {
- my($rref)=$refund->hashref;
- push @history,
- $rref->{_date} . "\tRefund, Credit #" . $rref->{crednum} . " (" .
- $rref->{payby} . " " . $rref->{payinfo} . ") by " .
- $rref->{otaker} . " - ". $rref->{reason} . "\t\t\t\t" .
- $rref->{refund};
- }
-}
-
- #formatting
- print <<END;
-<CENTER><TABLE BORDER=4>
-<TR>
- <TH>Date</TH>
- <TH>Description</TH>
- <TH><FONT SIZE=-1>Charge</FONT></TH>
- <TH><FONT SIZE=-1>Payment</FONT></TH>
- <TH><FONT SIZE=-1>In-house<BR>Credit</FONT></TH>
- <TH><FONT SIZE=-1>Refund</FONT></TH>
- <TH><FONT SIZE=-1>Balance</FONT></TH>
-</TR>
-END
-
-#display payment history
-
-my($balance)=0;
-my($item);
-foreach $item (sort keyfield_numerically @history) {
- my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item);
- $charge ||= 0;
- $payment ||= 0;
- $credit ||= 0;
- $refund ||= 0;
- $balance += $charge - $payment;
- $balance -= $credit - $refund;
-
- print "<TR><TD><FONT SIZE=-1>",time2str("%D",$date),"</FONT></TD>",
- "<TD><FONT SIZE=-1>$desc</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>",
- ( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
- "</FONT></TD>",
- "<TD><FONT SIZE=-1>\$" . sprintf("%.2f",$balance),
- "</FONT></TD>",
- "\n";
-}
-
-#formatting
-print "</TABLE></CENTER>";
-
-#end
-
-#formatting
-print <<END;
-
- </BODY>
-</HTML>
-END
-
-#subroutiens
-sub keyfield_numerically { (split(/\t/,$a))[0] <=> (split(/\t/,$b))[0] ; }
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# cust_pkg.cgi: View a package
-#
-# Usage: cust_pkg.cgi pkgnum
-# http://server.name/path/cust_pkg.cgi?pkgnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 96-dec-15
-#
-# services section needs to be cleaned up, needs to display extraneous
-# entries in cust_pkg!
-# ivan@voicenet.com 96-dec-31
-#
-# added navigation bar
-# ivan@voicenet.com 97-jan-30
-#
-# changed and fixed up suspension and cancel stuff, now you can't add
-# services to a cancelled package
-# ivan@voicenet.com 97-feb-27
-#
-# rewrote for new API, still needs to be cleaned up!
-# ivan@voicenet.com 97-jul-29
-#
-# no FS::Search ivan@sisd.com 98-mar-7
-
-use strict;
-use Date::Format;
-use CGI::Base qw(:DEFAULT :CGI); # CGI module
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearch qsearchs);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-my(%uiview,%uiadd);
-my($part_svc);
-foreach $part_svc ( qsearch('part_svc',{}) ) {
- $uiview{$part_svc->svcpart}="../view/". $part_svc->svcdb . ".cgi";
- $uiadd{$part_svc->svcpart}="../edit/". $part_svc->svcdb . ".cgi";
-}
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Package View</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>Package View</H1>
- </CENTER>
- <BASEFONT SIZE=3>
-END
-
-#untaint pkgnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($pkgnum)=$1;
-
-#get package record
-my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
-die "No package!" unless $cust_pkg;
-my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')});
-
-#nav bar
-my($custnum)=$cust_pkg->getfield('custnum');
-print qq!<CENTER><A HREF="../view/cust_main.cgi?$custnum">View this customer!,
- qq! (#$custnum)</A> | <A HREF="../">Main menu</A></CENTER><BR>!;
-
-#print info
-my($susp,$cancel,$expire)=(
- $cust_pkg->getfield('susp'),
- $cust_pkg->getfield('cancel'),
- $cust_pkg->getfield('expire'),
-);
-print "<FONT SIZE=+1><CENTER>Package #<B>$pkgnum</B></FONT>";
-print qq!<BR><A HREF="#package">Package Information</A>!;
-print qq! | <A HREF="#services">Service Information</A>! unless $cancel;
-print qq!</CENTER><HR>\n!;
-
-my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment'));
-print qq!<A NAME="package"><CENTER><FONT SIZE=+1>Package Information!,
- qq!</FONT></A>!;
-print qq!<BR><A HREF="../unimp.html">Edit this information</A></CENTER>!;
-print "<P>Package: <B>$pkg - $comment</B>";
-
-my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill'));
-print "<BR>Setup: <B>", $setup ? time2str("%D",$setup) : "(Not setup)" ,"</B>";
-print "<BR>Next bill: <B>", $bill ? time2str("%D",$bill) : "" ,"</B>";
-
-if ($susp) {
- print "<BR>Suspended: <B>", time2str("%D",$susp), "</B>";
- print qq! <A HREF="../misc/unsusp_pkg.cgi?$pkgnum">Unsuspend</A>! unless $cancel;
-} else {
- print qq!<BR><A HREF="../misc/susp_pkg.cgi?$pkgnum">Suspend</A>! unless $cancel;
-}
-
-if ($expire) {
- print "<BR>Expire: <B>", time2str("%D",$expire), "</B>";
-}
- print <<END;
-<FORM ACTION="../misc/expire_pkg.cgi" METHOD="post">
-<INPUT TYPE="hidden" NAME="pkgnum" VALUE="$pkgnum">
-Expire (date): <INPUT TYPE="text" NAME="date" VALUE="" >
-<INPUT TYPE="submit" VALUE="Cancel later">
-END
-
-if ($cancel) {
- print "<BR>Cancelled: <B>", time2str("%D",$cancel), "</B>";
-} else {
- print qq!<BR><A HREF="../misc/cancel_pkg.cgi?$pkgnum">Cancel now</A>!;
-}
-
-#otaker
-my($otaker)=$cust_pkg->getfield('otaker');
-print "<P>Order taken by <B>$otaker</B>";
-
-unless ($cancel) {
-
- #services
- print <<END;
-<HR><A NAME="services"><CENTER><FONT SIZE=+1>Service Information</FONT></A>
-<BR>Click on service to view/edit/add service.</CENTER><BR>
-<CENTER><B>Do NOT pick the "Link to existing" option unless you are auditing!!!</B></CENTER>
-<CENTER><TABLE BORDER=4>
-<TR><TH>Service</TH>
-END
-
- #list of services this pkgpart includes
- my($pkg_svc,%pkg_svc);
- foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $cust_pkg->pkgpart }) ) {
- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
- }
-
- #list of records from cust_svc
- my($svcpart);
- foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) {
-
- my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc');
-
- my(@cust_svc)=qsearch('cust_svc',{'pkgnum'=>$pkgnum,
- 'svcpart'=>$svcpart,
- });
-
- my($enum);
- for $enum ( 1 .. $pkg_svc{$svcpart} ) {
-
- my($cust_svc);
- if ( $cust_svc=shift @cust_svc ) {
- my($svcnum)=$cust_svc->svcnum;
- print <<END;
-<TR><TD><A HREF="$uiview{$svcpart}?$svcnum">(View) $svc<A></TD></TR>
-END
- } else {
- print <<END;
-<TR>
- <TD><A HREF="$uiadd{$svcpart}?pkgnum$pkgnum-svcpart$svcpart">
- (Add) $svc</A>
- or <A HREF="../misc/link.cgi?pkgnum$pkgnum-svcpart$svcpart">
- (Link to existing) $svc</A>
- </TD>
-</TR>
-END
- }
-
- }
- warn "WARNING: Leftover services pkgnum $pkgnum!" if @cust_svc;;
- }
-
- print "</TABLE></CENTER>";
-
-}
-
-#formatting
-print <<END;
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# View svc_acct records
-#
-# Usage: svc_acct.cgi svcnum
-# http://server.name/path/svc_acct.cgi?svcnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 96-dec-17
-#
-# added link to send info
-# ivan@voicenet.com 97-jan-4
-#
-# added navigation bar and ability to change username, etc.
-# ivan@voicenet.com 97-jan-30
-#
-# activate 800 service
-# ivan@voicenet.com 97-feb-10
-#
-# modified navbar code (should be a subroutine?), added link to cancel account (only if not audited)
-# ivan@voicenet.com 97-apr-16
-#
-# INCOMPLETELY rewrote some things for new API
-# ivan@voicenet.com 97-jul-29
-#
-# FS::Search became FS::Record, use strict, etc. ivan@sisd.com 98-mar-9
-#
-# Changes to allow page to work at a relative position in server
-# Changed 'password' to '_password' because Pg6.3 reserves the password word
-# bmccane@maxbaud.net 98-apr-3
-#
-# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
-#
-# displays arbitrary radius attributes ivan@sisd.com 98-aug-16
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use CGI::Carp qw(fatalsToBrowser);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs fields);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-&cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svcnum});
-die "Unkonwn svcnum" unless $svc_acct;
-
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
-if ($pkgnum) {
- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- $custnum=$cust_pkg->getfield('custnum');
-}
-
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-die "Unkonwn svcpart" unless $part_svc;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Account View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Account View</H1>
- <BASEFONT SIZE=3>
-<CENTER>
-END
-
-if ($pkgnum || $custnum) {
- print <<END;
-<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
-<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
-END
-} else {
- print <<END;
-<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
-END
-}
-
-print <<END;
-<A HREF="../">Main menu</A></CENTER><BR>
-<FONT SIZE=+1>Service #$svcnum</FONT>
-END
-
-print qq!<BR><A HREF="../edit/svc_acct.cgi?$svcnum">Edit this information</A>!;
-#print qq!<BR><A HREF="../misc/sendconfig.cgi?$svcnum">Send account information</A>!;
-print qq!<BR><BR><A HREF="#general">General</A> | <A HREF="#shell">Shell account</A> | !;
-print qq!<A HREF="#slip">SLIP/PPP account</A></CENTER>!;
-
-#formatting
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="general">General</A></FONT></CENTER>!;
-
-#svc
-print "Service: <B>", $part_svc->svc, "</B>";
-
-#username
-print "<BR>Username: <B>", $svc_acct->username, "</B>";
-
-#password
-if (substr($svc_acct->_password,0,1) eq "*") {
- print "<BR>Password: <I>(Login disabled)</I><BR>";
-} else {
- print "<BR>Password: <I>(hidden)</I><BR>";
-}
-
-# popnum -> svc_acct_pop record
-my($svc_acct_pop)=qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum});
-
-#pop
-print "POP: <B>", $svc_acct_pop->city, ", ", $svc_acct_pop->state,
- " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "<\B>"
- if $svc_acct_pop;
-
-#shell account
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="shell">!;
-if ($svc_acct->uid ne '') {
- print "Shell account";
- print "</A></FONT></CENTER>";
- print "Uid: <B>", $svc_acct->uid, "</B>";
- print "<BR>Gid: <B>", $svc_acct->gid, "</B>";
-
- print qq!<BR>Finger name: <B>!, $svc_acct->finger, qq!</B><BR>!;
-
- print "Home directory: <B>", $svc_acct->dir, "</B><BR>";
-
- print "Shell: <B>", $svc_acct->shell, "</B><BR>";
-
- print "Quota: <B>", $svc_acct->quota, "</B> <I>(unimplemented)</I>";
-} else {
- print "No shell account.</A></FONT></CENTER>";
-}
-
-# SLIP/PPP
-print qq!<HR><CENTER><FONT SIZE=+1><A NAME="slip">!;
-if ($svc_acct->slipip) {
- print "SLIP/PPP account</A></FONT></CENTER>";
- print "IP address: <B>", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "<I>(Dynamic)</I>" : $svc_acct->slipip ,"</B>";
- my($attribute);
- foreach $attribute ( grep /^radius_/, fields('svc_acct') ) {
- #warn $attribute;
- $attribute =~ /^radius_(.*)$/;
- my($pattribute) = ($1);
- $pattribute =~ s/_/-/g;
- print "<BR>Radius $pattribute: <B>". $svc_acct->getfield($attribute), "</B>";
- }
-} else {
- print "No SLIP/PPP account</A></FONT></CENTER>"
-}
-
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# View svc_acct_sm records
-#
-# Usage: svc_acct_sm.cgi svcnum
-# http://server.name/path/svc_acct_sm.cgi?svcnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# based on view/svc_acct.cgi
-#
-# ivan@voicenet.com 97-jan-5
-#
-# added navigation bar
-# ivan@voicenet.com 97-jan-30
-#
-# rewrite ivan@sisd.com 98-mar-15
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-#
-# /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_acct_sm)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum});
-die "Unknown svcnum" unless $svc_acct_sm;
-
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
-if ($pkgnum) {
- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- $custnum=$cust_pkg->getfield('custnum');
-}
-
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-die "Unkonwn svcpart" unless $part_svc;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Mail Alias View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Mail Alias View</H1>
-END
-if ($pkgnum || $custnum) {
- print <<END;
-<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
-<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
-END
-} else {
- print <<END;
-<A HREF="../misc/cancel-unaudited.cgi?$svcnum">Cancel this (unaudited)account</A> |
-END
-}
-
-print <<END;
- <A HREF="../">Main menu</A></CENTER><BR<
- <FONT SIZE=+1>Service #$svcnum</FONT>
- <P><A HREF="../edit/svc_acct_sm.cgi?$svcnum">Edit this information</A>
- <BASEFONT SIZE=3>
-END
-
-my($domsvc,$domuid,$domuser)=(
- $svc_acct_sm->domsvc,
- $svc_acct_sm->domuid,
- $svc_acct_sm->domuser,
-);
-my($svc) = $part_svc->svc;
-my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc});
-my($domain)=$svc_domain->domain;
-my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
-my($username)=$svc_acct->username;
-
-#formatting
-print qq!<HR>!;
-
-#svc
-print "Service: <B>$svc</B>";
-
-print "<HR>";
-
-print qq!Mail to <B>!, ( ($domuser eq '*') ? "<I>(anything)</I>" : $domuser ) , qq!</B>\@<B>$domain</B> forwards to <B>$username</B>\@$mydomain mailbox.!;
-
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# View svc_domain records
-#
-# Usage: svc_domain svcnum
-# http://server.name/path/svc_domain.cgi?svcnum
-#
-# Note: Should be run setuid freeside as user nobody.
-#
-# ivan@voicenet.com 97-jan-6
-#
-# rewrite ivan@sisd.com 98-mar-14
-#
-# Changes to allow page to work at a relative position in server
-# bmccane@maxbaud.net 98-apr-3
-
-use strict;
-use CGI::Base qw(:DEFAULT :CGI);
-use FS::UID qw(cgisuidsetup);
-use FS::Record qw(qsearchs);
-
-my($cgi) = new CGI::Base;
-$cgi->get;
-cgisuidsetup($cgi);
-
-#untaint svcnum
-$QUERY_STRING =~ /^(\d+)$/;
-my($svcnum)=$1;
-my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svcnum});
-die "Unknown svcnum" unless $svc_domain;
-my($domain)=$svc_domain->domain;
-
-my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
-my($pkgnum)=$cust_svc->getfield('pkgnum');
-my($cust_pkg,$custnum);
-if ($pkgnum) {
- $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- $custnum=$cust_pkg->getfield('custnum');
-}
-
-my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-die "Unkonwn svcpart" unless $part_svc;
-
-SendHeaders(); # one guess.
-print <<END;
-<HTML>
- <HEAD>
- <TITLE>Domain View</TITLE>
- </HEAD>
- <BODY>
- <CENTER><H1>Domain View</H1>
- <BASEFONT SIZE=3>
-<CENTER>
-<A HREF="../view/cust_pkg.cgi?$pkgnum">View this package (#$pkgnum)</A> |
-<A HREF="../view/cust_main.cgi?$custnum">View this customer (#$custnum)</A> |
-<A HREF="../">Main menu</A></CENTER><BR>
- <FONT SIZE=+1>Service #$svcnum</FONT>
- </CENTER>
-END
-
-print "<HR>";
-print "Service: <B>", $part_svc->svc, "</B>";
-print "<HR>";
-
-print qq!Domain name <B>$domain</B>.!;
-print qq!<P><A HREF="http://rs.internic.net/cgi-bin/whois?do+$domain">View whois information.</A>!;
-
-print "<HR>";
-
- #formatting
- print <<END;
-
- </BODY>
-</HTML>
-END
-
+++ /dev/null
-package FS::Bill;
-
-use strict;
-use vars qw(@ISA);
-use FS::cust_main;
-
-@ISA = qw(FS::cust_main);
-
-warn "FS::Bill depriciated\n";
-
-=head1 NAME
-
-FS::Bill - Legacy stub
-
-=head1 SYNOPSIS
-
-The functionality of FS::Bill has been integrated into FS::cust_main.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-24 - 25 - 28
-
-use Safe; evaluate all fees with perl (still on TODO list until I write
-some examples & test opmask to see if we can read db)
-%hash=$obj->hash later ivan@sisd.com 98-mar-13
-
-packages with no next bill date start at $time not time, this should
-eliminate the last of the problems with billing at a past date
-also rewrite the invoice priting logic not to print invoices for things
-that haven't happended yet and update $cust_bill->printed when we print
-so PAST DUE notices work, and s/date/_date/
-ivan@sisd.com 98-jun-4
-
-more logic for past due stuff - packages with no next bill date start
-at $cust_pkg->setup || $time ivan@sisd.com 98-jul-13
-
-moved a few things in collection logic; negative charges should work
-ivan@sisd.com 98-aug-6
-
-pod, moved everything to FS::cust_main ivan@sisd.com 98-sep-19
-
-=cut
-
-1;
+++ /dev/null
-package FS::CGI;
-
-use strict;
-use vars qw(@EXPORT_OK @ISA);
-use Exporter;
-use CGI::Base;
-use CGI::Carp qw(fatalsToBrowser);
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(header menubar idiot eidiot);
-
-=head1 NAME
-
-FS::CGI - Subroutines for the web interface
-
-=head1 SYNOPSIS
-
- use FS::CGI qw(header menubar idiot eidiot);
-
- print header( 'Title', '' );
- print header( 'Title', menubar('item', 'URL', ... ) );
-
- idiot "error message";
- eidiot "error message";
-
-=head1 DESCRIPTION
-
-Provides a few common subroutines for the web interface.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item header TITLE, MENUBAR
-
-Returns an HTML header.
-
-=cut
-
-sub header {
- my($title,$menubar)=@_;
-
- <<END;
- <HTML>
- <HEAD>
- <TITLE>
- $title
- </TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H1>
- $title
- </H1>
- $menubar
- </CENTER>
- <HR>
-END
-}
-
-=item menubar ITEM, URL, ...
-
-Returns an HTML menubar.
-
-=cut
-
-sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... );
- my($item,$url,@html);
- while (@_) {
- ($item,$url)=splice(@_,0,2);
- push @html, qq!<A HREF="$url">$item</A>!;
- }
- join(' | ',@html);
-}
-
-=item idiot ERROR
-
-Sends headers and an HTML error message.
-
-=cut
-
-sub idiot {
- my($error)=@_;
- CGI::Base::SendHeaders();
- print <<END;
-<HTML>
- <HEAD>
- <TITLE>Error processing your request</TITLE>
- </HEAD>
- <BODY>
- <CENTER>
- <H4>Error processing your request</H4>
- </CENTER>
- Your request could not be processed because of the following error:
- <P><B>$error</B>
- <P>Hit the <I>Back</I> button in your web browser, correct this mistake, and try again.
- </BODY>
-</HTML>
-END
-
-}
-
-=item eidiot ERROR
-
-Sends headers and an HTML error message, then exits.
-
-=cut
-
-sub eidiot {
- idiot(@_);
- exit;
-}
-
-=back
-
-=head1 BUGS
-
-Not OO.
-
-Not complete.
-
-Uses CGI-modules instead of CGI.pm
-
-=head1 SEE ALSO
-
-L<CGI::Base>
-
-=head1 HISTORY
-
-subroutines for the HTML/CGI GUI, not properly OO. :(
-
-ivan@sisd.com 98-apr-16
-ivan@sisd.com 98-jun-22
-
-lose the background, eidiot ivan@sisd.com 98-sep-2
-
-pod ivan@sisd.com 98-sep-12
-
-=cut
-
-1;
-
-
+++ /dev/null
-package FS::Conf;
-
-use vars qw($default_dir);
-use IO::File;
-
-$default_dir='/var/spool/freeside/conf';
-
-=head1 NAME
-
-FS::Conf - Read access to Freeside configuration values
-
-=head1 SYNOPSIS
-
- use FS::Conf;
-
- $conf = new FS::Conf;
- $conf = new FS::Conf "/non/standard/config/directory";
-
- $dir = $conf->dir;
-
- $value = $conf->config('key');
- @list = $conf->config('key');
- $bool = $conf->exists('key');
-
-=head1 DESCRIPTION
-
-Read access to Freeside configuration values. Keys currently map to filenames,
-but this may change in the future.
-
-=head1 METHODS
-
-=over 4
-
-=item new [ DIRECTORY ]
-
-Create a new configuration object. Optionally, a non-default directory may
-be specified.
-
-=cut
-
-sub new {
- my($proto,$dir) = @_;
- my($class) = ref($proto) || $proto;
- my($self) = { 'dir' => $dir || $default_dir } ;
- bless ($self, $class);
-}
-
-=item dir
-
-Returns the directory.
-
-=cut
-
-sub dir {
- my($self) = @_;
- $self->{dir};
-}
-
-=item config
-
-Returns the configuration value or values (depending on context) for key.
-
-=cut
-
-sub config {
- my($self,$file)=@_;
- my($dir)=$self->dir;
- my $fh = new IO::File "<$dir/$file" or return;
- if ( wantarray ) {
- map {
- /^(.*)$/ or die "Illegal line in $dir/$file:\n$_\n";
- $1;
- } <$fh>;
- } else {
- <$fh> =~ /^(.*)$/ or die "Illegal line in $dir/$file:\n$_\n";
- $1;
- }
-}
-
-=item exists
-
-Returns true if the specified key exists, even if the corresponding value
-is undefined.
-
-=cut
-
-sub exists {
- my($self,$file)=@_;
- my($dir) = $self->dir;
- -e "$dir/$file";
-}
-
-=back
-
-=head1 BUGS
-
-The option to specify a non-default directory should probably be removed.
-
-Write access (with locking) should be implemented.
-
-=head1 SEE ALSO
-
-config.html from the base documentation contains a list of configuration files.
-
-=head1 HISTORY
-
-Ivan Kohler <ivan@sisd.com> 98-sep-6
-
-sub exists forgot to fetch $dir ivan@sisd.com 98-sep-27
-
-=cut
-
-1;
+++ /dev/null
-package FS::Invoice;
-
-use strict;
-use vars qw(@ISA);
-use FS::cust_bill;
-
-@ISA = qw(FS::cust_bill);
-
-#warn "FS::Invoice depriciated\n";
-
-=head1 NAME
-
-FS::Invoice - Legacy stub
-
-=head1 SYNOPSIS
-
-The functioanlity of FS::invoice has been integrated in FS::cust_bill.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jun-25 - 27
-
-maybe should be changed to be OO-functions on $cust_bill objects?
-(instead of passing invnum, ugh).
-
-ISA cust_bill and return inovice instead of passing filehandle
-ivan@sisd.com 98-mar-13
-
-(add postscript output!)
-
-close our kid when we're done ivan@sisd.com 98-jun-4
-
-separated code which shuffled data from code which formatted.
-(so i could) fixed past due notices showing up when balance due =< 0
-return address comes from /var/spool/freeside/conf/address
-ivan@sisd.com 98-jul-2
-
-pod ivan@sisd.com 98-sep-20something
-
-s/ISA/@ISA/ in use vars ivan@sisd.com 98-sep-27
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::Record;
-
-use strict;
-use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK);
-use subs qw(reload_dbdef);
-use Exporter;
-use Carp;
-use File::CounterFile;
-use FS::UID qw(dbh checkruid swapuid getotaker datasrc);
-use FS::dbdef;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
-
-$File::CounterFile::DEFAULT_DIR = "/var/spool/freeside/counters" ;
-
-$dbdef_file = "/var/spool/freeside/dbdef.". datasrc;
-
-reload_dbdef unless $setup_hack;
-
-=head1 NAME
-
-FS::Record - Database record objects
-
-=head1 SYNOPSIS
-
- use FS::Record;
- use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
-
- $record = new FS::Record 'table', \%hash;
- $record = new FS::Record 'table', { 'column' => 'value', ... };
-
- $record = qsearchs FS::Record 'table', \%hash;
- $record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
- @records = qsearch FS::Record 'table', \%hash;
- @records = qsearch FS::Record 'table', { 'column' => 'value', ... };
-
- $table = $record->table;
- $dbdef_table = $record->dbdef_table;
-
- $value = $record->get('column');
- $value = $record->getfield('column');
- $value = $record->column;
-
- $record->set( 'column' => 'value' );
- $record->setfield( 'column' => 'value' );
- $record->column('value');
-
- %hash = $record->hash;
-
- $hashref = $record->hashref;
-
- $error = $record->add;
-
- $error = $record->del;
-
- $error = $new_record->rep($old_record);
-
- $value = $record->unique('column');
-
- $value = $record->ut_float('column');
- $value = $record->ut_number('column');
- $value = $record->ut_numbern('column');
- $value = $record->ut_money('column');
- $value = $record->ut_text('column');
- $value = $record->ut_textn('column');
- $value = $record->ut_alpha('column');
- $value = $record->ut_alphan('column');
- $value = $record->ut_phonen('column');
- $value = $record->ut_anythingn('column');
-
- $dbdef = reload_dbdef;
- $dbdef = reload_dbdef "/non/standard/filename";
- $dbdef = dbdef;
-
- $quoted_value = _quote($value,'table','field');
-
- #depriciated
- $fields = hfields('table');
- if ( $fields->{Field} ) { # etc.
-
- @fields = fields 'table';
-
-
-=head1 DESCRIPTION
-
-(Mostly) object-oriented interface to database records. Records are currently
-implemented on top of DBI. FS::Record is intended as a base class for
-table-specific classes to inherit from, i.e. FS::cust_main.
-
-=head1 METHODS
-
-=over 4
-
-=item new TABLE, HASHREF
-
-Creates a new record. It doesn't store it in the database, though. See
-L<"add"> for that.
-
-Note that the object stores this hash reference, not a distinct copy of the
-hash it points to. You can ask the object for a copy with the I<hash>
-method.
-
-=cut
-
-sub new {
- my($proto,$table,$hashref) = @_;
- confess "Second arguement to FS::Record->new is not a HASH ref: ",
- ref($hashref), " ", $hashref, "\n"
- unless ref($hashref) eq 'HASH'; #bad practice?
-
- #check to make sure $table exists? (ask dbdef)
-
- foreach my $field ( FS::Record::fields $table ) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- # mySQL must rtrim the inbound text strings or store them z-terminated
- # I simulate this for Postgres below
- # Turned off in favor of ChopBlanks in UID.pm (see man DBI)
- #if (datasrc =~ m/Pg/)
- #{
- # foreach my $index (keys %$hashref)
- # {
- # $$hashref{$index} = unpack("A255", $$hashref{$index})
- # if ($$hashref{$index} =~ m/ $/) ;
- # }
- #}
-
- foreach my $column (keys %{$hashref}) {
- #trim the '$' from money fields for Pg (beong HERE?)
- #(what about Pg i18n?)
- if ( datasrc =~ m/Pg/
- && $dbdef->table($table)->column($column)->type eq 'money' ) {
- ${$hashref}{$column} =~ s/^\$//;
- }
- #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) {
- # ${$hashref}{$column} =~ s/^\$//;
- #}
- }
-
- my $class = ref($proto) || $proto;
- my $self = { 'Table' => $table,
- 'Hash' => $hashref,
- };
-
- bless ($self, $class);
-
-}
-
-=item qsearch TABLE, HASHREF
-
-Searches the database for all records matching (at least) the key/value pairs
-in HASHREF. Returns all the records found as FS::Record objects.
-
-=cut
-
-# Usage: @records = &FS::Search::qsearch($table,\%hash);
-# Each element of @records is a FS::Record object.
-sub qsearch {
- my($table,$record) = @_;
- my($dbh) = dbh;
-
- my(@fields)=grep exists($record->{$_}), fields($table);
-
- my($sth);
- my($statement) = "SELECT * FROM $table". ( @fields
- ? " WHERE ". join(' AND ',
- map("$_ = ". _quote($record->{$_},$table,$_), @fields)
- )
- : ''
- );
- $sth=$dbh->prepare($statement)
- or croak $dbh->errstr; #is that a little too harsh? hmm.
-
- map {
- new FS::Record ($table,$sth->fetchrow_hashref);
- } ( 1 .. $sth->execute );
-
-}
-
-=item qsearchs TABLE, HASHREF
-
-Searches the database for a record matching (at least) the key/value pairs
-in HASHREF, and returns the record found as an FS::Record object. If more than
-one record matches, it B<carp>s but returns the first. If this happens, you
-either made a logic error in asking for a single item, or your data is
-corrupted.
-
-=cut
-
-sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
- my(@result) = qsearch(@_);
- carp "Multiple records in scalar search!" if scalar(@result) > 1;
- #should warn more vehemently if the search was on a primary key?
- $result[0];
-}
-
-=item table
-
-Returns the table name.
-
-=cut
-
-sub table {
- my($self) = @_;
- $self -> {'Table'};
-}
-
-=item dbdef_table
-
-Returns the FS::dbdef_table object for the table.
-
-=cut
-
-sub dbdef_table {
- my($self)=@_;
- my($table)=$self->table;
- $dbdef->table($table);
-}
-
-=item get, getfield COLUMN
-
-Returns the value of the column/field/key COLUMN.
-
-=cut
-
-sub get {
- my($self,$field) = @_;
- # to avoid "Use of unitialized value" errors
- if ( defined ( $self->{Hash}->{$field} ) ) {
- $self->{Hash}->{$field};
- } else {
- '';
- }
-}
-sub getfield {
- get(@_);
-}
-
-=item set, setfield COLUMN, VALUE
-
-Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE.
-
-=cut
-
-sub set {
- my($self,$field,$value) = @_;
- $self->{'Hash'}->{$field} = $value;
-}
-sub setfield {
- set(@_);
-}
-
-=item AUTLOADED METHODS
-
-$record->column is a synonym for $record->get('column');
-
-$record->column('value') is a synonym for $record->set('column','value');
-
-=cut
-
-sub AUTOLOAD {
- my($self,$value)=@_;
- my($field)=$AUTOLOAD;
- $field =~ s/.*://;
- if ( defined($value) ) {
- $self->setfield($field,$value);
- } else {
- $self->getfield($field);
- }
-}
-
-=item hash
-
-Returns a list of the column/value pairs, usually for assigning to a new hash.
-
-To make a distinct duplicate of an FS::Record object, you can do:
-
- $new = new FS::Record ( $old->table, { $old->hash } );
-
-=cut
-
-sub hash {
- my($self) = @_;
- %{ $self->{'Hash'} };
-}
-
-=item hashref
-
-Returns a reference to the column/value hash.
-
-=cut
-
-sub hashref {
- my($self) = @_;
- $self->{'Hash'};
-}
-
-=item add
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub add {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
-
- #single-field unique keys are given a value if false
- #(like MySQL's AUTO_INCREMENT)
- foreach ( $dbdef->table($table)->unique->singles ) {
- $self->unique($_) unless $self->getfield($_);
- }
- #and also the primary key
- my($primary_key)=$dbdef->table($table)->primary_key;
- $self->unique($primary_key)
- if $primary_key && ! $self->getfield($primary_key);
-
- my (@fields) =
- grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- fields($table)
- ;
-
- my($sth);
- my($statement)="INSERT INTO $table ( ".
- join(', ',@fields ).
- ") VALUES (".
- join(', ',map(_quote($self->getfield($_),$table,$_), @fields)).
- ")"
- ;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $sth->execute or return $sth->errstr;
-
- '';
-}
-
-=item del
-
-Delete this record from the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub del {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
-
- my($sth);
- my($statement)="DELETE FROM $table WHERE ". join(' AND ',
- map {
- $self->getfield($_) eq ''
- ? "$_ IS NULL"
- : "$_ = ". _quote($self->getfield($_),$table,$_)
- } ( $dbdef->table($table)->primary_key )
- ? ($dbdef->table($table)->primary_key)
- : fields($table)
- );
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($rc);
- $rc=$sth->execute or return $sth->errstr;
- #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
-
- undef $self; #no need to keep object!
-
- '';
-}
-
-=item rep OLD_RECORD
-
-Replace the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub rep {
- my($new,$old)=@_;
- my($dbh)=dbh;
- my($table)=$old->table;
- my(@fields)=fields($table);
- my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields;
-
- if ( scalar(@diff) == 0 ) {
- carp "Records identical";
- return '';
- }
-
- return "Records not in same table!" unless $new->table eq $table;
-
- my($sth);
- my($statement)="UPDATE $table SET ". join(', ',
- map {
- "$_ = ". _quote($new->getfield($_),$table,$_)
- } @diff
- ). ' WHERE '.
- join(' AND ',
- map {
- $old->getfield($_) eq ''
- ? "$_ IS NULL"
- : "$_ = ". _quote($old->getfield($_),$table,$_)
-# } @fields
-# } ( primary_key($table) ? (primary_key($table)) : @fields )
- } ( $dbdef->table($table)->primary_key
- ? ($dbdef->table($table)->primary_key)
- : @fields
- )
- )
- ;
- #warn $statement;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($rc);
- $rc=$sth->execute or return $sth->errstr;
- #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
-
- '';
-
-}
-
-=item unique COLUMN
-
-Replaces COLUMN in record with a unique number. Called by the B<add> method
-on primary keys and single-field unique columns (see L<FS::dbdef_table>).
-Returns the new value.
-
-=cut
-
-sub unique {
- my($self,$field) = @_;
- my($table)=$self->table;
-
- croak("&FS::UID::checkruid failed") unless &checkruid;
-
- croak "Unique called on field $field, but it is ",
- $self->getfield($field),
- ", not null!"
- if $self->getfield($field);
-
- #warn "table $table is tainted" if is_tainted($table);
- #warn "field $field is tainted" if is_tainted($field);
-
- &swapuid;
- my($counter) = new File::CounterFile "$table.$field",0;
-# hack for web demo
-# getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
-# my($user)=$1;
-# my($counter) = new File::CounterFile "$user/$table.$field",0;
-# endhack
-
- my($index)=$counter->inc;
- $index=$counter->inc
- while qsearchs($table,{$field=>$index}); #just in case
- &swapuid;
-
- $index =~ /^(\d*)$/;
- $index=$1;
-
- $self->setfield($field,$index);
-
-}
-
-=item ut_float COLUMN
-
-Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May not be
-null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_float {
- my($self,$field)=@_ ;
- ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
- $self->getfield($field) =~ /^(\d+)$/ ||
- $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
- $self->getfield($field) =~ /^(\d+e\d+)$/)
- or return "Illegal or empty (float) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_number COLUMN
-
-Check/untaint simple numeric data (whole numbers). May not be null. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_number {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\d+)$/
- or return "Illegal or empty (numeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_numbern COLUMN
-
-Check/untaint simple numeric data (whole numbers). May be null. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_numbern {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\d*)$/
- or return "Illegal (numeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_money COLUMN
-
-Check/untaint monetary numbers. May be negative. Set to 0 if null. If there
-is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_money {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
- or return "Illegal (money) $field!";
- $self->setfield($field,"$1$2$3" || 0);
- '';
-}
-
-=item ut_text COLUMN
-
-Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
-May not be null. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub ut_text {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
- or return "Illegal or empty (text) $field";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_textn COLUMN
-
-Check/untaint text. Alphanumerics, spaces, and the following punctuation
-symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
-May be null. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_textn {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
- or return "Illegal (text) $field";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_alpha COLUMN
-
-Check/untaint alphanumeric strings (no spaces). May not be null. If there is
-an error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alpha {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w+)$/
- or return "Illegal or empty (alphanumeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_alpha COLUMN
-
-Check/untaint alphanumeric strings (no spaces). May be null. If there is an
-error, returns the error, otherwise returns false.
-
-=cut
-
-sub ut_alphan {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w*)$/
- or return "Illegal (alphanumeric) $field!";
- $self->setfield($field,$1);
- '';
-}
-
-=item ut_phonen COLUMN
-
-Check/untaint phone numbers. May be null. If there is an error, returns
-the error, otherwise returns false.
-
-=cut
-
-sub ut_phonen {
- my($self,$field)=@_;
- my $phonen = $self->getfield($field);
- if ( $phonen eq '' ) {
- $self->setfield($field,'');
- } else {
- $phonen =~ s/\D//g;
- $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
- or return "Illegal (phone) $field!";
- $phonen = "$1-$2-$3";
- $phonen .= " x$4" if $4;
- $self->setfield($field,$phonen);
- }
- '';
-}
-
-=item ut_anything COLUMN
-
-Untaints arbitrary data. Be careful.
-
-=cut
-
-sub ut_anything {
- my($self,$field)=@_;
- $self->getfield($field) =~ /^(.*)$/ or return "Illegal $field!";
- $self->setfield($field,$1);
- '';
-}
-
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item reload_dbdef([FILENAME])
-
-Load a database definition (see L<FS::dbdef>), optionally from a non-default
-filename. This command is executed at startup unless
-I<$FS::Record::setup_hack> is true. Returns a FS::dbdef object.
-
-=cut
-
-sub reload_dbdef {
- my $file = shift || $dbdef_file;
- $dbdef = load FS::dbdef ($file);
-}
-
-=item dbdef
-
-Returns the current database definition. See L<FS::dbdef>.
-
-=cut
-
-sub dbdef { $dbdef; }
-
-=item _quote VALUE, TABLE, COLUMN
-
-This is an internal function used to construct SQL statements. It returns
-VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
-type (see L<dbdef_column>) does not end in `char' or `binary'.
-
-=cut
-
-sub _quote {
- my($value,$table,$field)=@_;
- my($dbh)=dbh;
- if ( $value =~ /^\d+(\.\d+)?$/ &&
-# ! ( datatype($table,$field) =~ /^char/ )
- ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i )
- ) {
- $value;
- } else {
- $dbh->quote($value);
- }
-}
-
-=item hfields TABLE
-
-This is depriciated. Don't use it.
-
-It returns a hash-type list with the fields of this record's table set true.
-
-=cut
-
-sub hfields {
- carp "hfields is depriciated";
- my($table)=@_;
- my(%hash);
- foreach (fields($table)) {
- $hash{$_}=1;
- }
- \%hash;
-}
-
-=item fields TABLE
-
-This returns a list of the columns in this record's table
-(See L<dbdef_table>).
-
-=cut
-
-# Usage: @fields = fields($table);
-sub fields {
- my($table) = @_;
- #my(@fields) = $dbdef->table($table)->columns;
- croak "Usage: \@fields = fields(\$table)" unless $table;
- my($table_obj) = $dbdef->table($table);
- croak "Unknown table $table" unless $table_obj;
- $table_obj->columns;
-}
-
-#sub _dump {
-# my($self)=@_;
-# join("\n", map {
-# "$_: ". $self->getfield($_). "|"
-# } (fields($self->table)) );
-#}
-
-#sub DESTROY {
-# my $self = shift;
-# #use Carp qw(cluck);
-# #cluck "DESTROYING $self";
-# warn "DESTROYING $self";
-#}
-
-#sub is_tainted {
-# return ! eval { join('',@_), kill 0; 1; };
-# }
-
-=back
-
-=head1 BUGS
-
-This module should probably be renamed, since much of the functionality is
-of general use. It is not completely unlike Adapter::DBI (see below).
-
-Exported qsearch and qsearchs should be depriciated in favor of method calls
-(against an FS::Record object like the old search and searchs that qsearch
-and qsearchs were on top of.)
-
-The whole fields / hfields mess should be removed.
-
-The various WHERE clauses should be subroutined.
-
-table string should be depriciated in favor of FS::dbdef_table.
-
-No doubt we could benefit from a Tied hash. Documenting how exists / defined
-true maps to the database (and WHERE clauses) would also help.
-
-The ut_ methods should ask the dbdef for a default length.
-
-ut_sqltype (like ut_varchar) should all be defined
-
-A fallback check method should be provided with uses the dbdef.
-
-The ut_money method assumes money has two decimal digits.
-
-The Pg money kludge in the new method only strips `$'.
-
-The ut_phonen method assumes US-style phone numbers.
-
-The _quote function should probably use ut_float instead of a regex.
-
-All the subroutines probably should be methods, here or elsewhere.
-
-=head1 SEE ALSO
-
-L<FS::dbdef>, L<FS::UID>, L<DBI>
-
-Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jun-2 - 9, 19, 25, 27, 30
-
-DBI version
-ivan@sisd.com 97-nov-8 - 12
-
-cleaned up, added autoloaded $self->any_field calls, moved DBI login stuff
-to FS::UID
-ivan@sisd.com 97-nov-21-23
-
-since AUTO_INCREMENT is MySQL specific, use my own unique number generator
-(again)
-ivan@sisd.com 97-dec-4
-
-untaint $user in unique (web demo hack...bah)
-make unique skip multiple-field unique's from dbdef
-ivan@sisd.com 97-dec-11
-
-merge with FS::Search, which after all was just alternate constructors for
-FS::Record objects. Makes lots of things cleaner. :)
-ivan@sisd.com 97-dec-13
-
-use FS::dbdef::primary key in replace searches, hopefully for all practical
-purposes the string/number problem in SQL statements should be gone?
-(SQL bites)
-ivan@sisd.com 98-jan-20
-
-Put all SQL statments in $statment before we $sth=$dbh->prepare( them,
-for debugging reasons (warn $statement) ivan@sisd.com 98-feb-19
-
-(sigh)... use dbdef type (char, etc.) instead of a regex to decide
-what to quote in _quote (more sillines...) SQL bites.
-ivan@sisd.com 98-feb-20
-
-more friendly error messages ivan@sisd.com 98-mar-13
-
-Added import of datasrc from FS::UID to allow Pg6.3 to work
-Added code to right-trim strings read from Pg6.3 databases
-Modified 'add' to only insert fields that actually have data
-Added ut_float to handle floating point numbers (for sales tax).
-Pg6.3 does not have a "SHOW FIELDS" statement, so I faked it 8).
- bmccane@maxbaud.net 98-apr-3
-
-commented out Pg wrapper around `` Modified 'add' to only insert fields that
-actually have data '' ivan@sisd.com 98-apr-16
-
-dbdef usage changes ivan@sisd.com 98-jun-1
-
-sub fields now asks dbdef, not database ivan@sisd.com 98-jun-2
-
-added debugging method ->_dump ivan@sisd.com 98-jun-16
-
-use FS::dbdef::primary key in delete searches as well as replace
-searches (SQL still bites) ivan@sisd.com 98-jun-22
-
-sub dbdef_table ivan@sisd.com 98-jun-28
-
-removed Pg wrapper around `` Modified 'add' to only insert fields that
-actually have data '' ivan@sisd.com 98-jul-14
-
-sub fields croaks on errors ivan@sisd.com 98-jul-17
-
-$rc eq '0E0' doesn't mean we couldn't delete for all rdbmss
-ivan@sisd.com 98-jul-18
-
-commented out code to right-trim strings read from Pg6.3 databases;
-ChopBlanks is in UID.pm ivan@sisd.com 98-aug-16
-
-added code (with Pg wrapper) to deal with Pg money fields
-ivan@sisd.com 98-aug-18
-
-added pod documentation ivan@sisd.com 98-sep-6
-
-ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::SSH;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $ssh $scp);
-use Exporter;
-use IPC::Open2;
-use IPC::Open3;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(ssh scp issh iscp sshopen2 sshopen3);
-
-$ssh="ssh";
-$scp="scp";
-
-=head1 NAME
-
-FS::SSH - Subroutines to call ssh and scp
-
-=head1 SYNOPSIS
-
- use FS::SSH qw(ssh scp issh iscp sshopen2 sshopen3);
-
- ssh($host, $command);
-
- issh($host, $command);
-
- scp($source, $destination);
-
- iscp($source, $destination);
-
- sshopen2($host, $reader, $writer, $command);
-
- sshopen3($host, $reader, $writer, $error, $command);
-
-=head1 DESCRIPTION
-
- Simple wrappers around ssh and scp commands.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item ssh HOST, COMMAND
-
-Calls ssh in batch mode.
-
-=cut
-
-sub ssh {
- my($host,$command)=@_;
- my(@cmd)=($ssh, "-o", "BatchMode yes", $host, $command);
-# print join(' ',@cmd),"\n";
-#0;
- system(@cmd);
-}
-
-=item issh HOST, COMMAND
-
-Prints the ssh command to be executed, waits for the user to confirm, and
-(optionally) executes the command.
-
-=cut
-
-sub issh {
- my($host,$command)=@_;
- my(@cmd)=($ssh, $host, $command);
- print join(' ',@cmd),"\n";
- if ( &_yesno ) {
- ###print join(' ',@cmd),"\n";
- system(@cmd);
- }
-}
-
-=item scp SOURCE, DESTINATION
-
-Calls scp in batch mode.
-
-=cut
-
-sub scp {
- my($src,$dest)=@_;
- my(@cmd)=($scp,"-Bprq",$src,$dest);
-# print join(' ',@cmd),"\n";
-#0;
- system(@cmd);
-}
-
-=item iscp SOURCE, DESTINATION
-
-Prints the scp command to be executed, waits for the user to confirm, and
-(optionally) executes the command.
-
-=cut
-
-sub iscp {
- my($src,$dest)=@_;
- my(@cmd)=($scp,"-pr",$src,$dest);
- print join(' ',@cmd),"\n";
- if ( &_yesno ) {
- ###print join(' ',@cmd),"\n";
- system(@cmd);
- }
-}
-
-=item sshopen2 HOST, READER, WRITER, COMMAND
-
-Connects the supplied filehandles to the ssh process (in batch mode).
-
-=cut
-
-sub sshopen2 {
- my($host,$reader,$writer,$command)=@_;
- open2($reader,$writer,$ssh,'-o','Batchmode yes',$host,$command);
-}
-
-=item sshopen3 HOST, WRITER, READER, ERROR, COMMAND
-
-Connects the supplied filehandles to the ssh process (in batch mode).
-
-=cut
-
-sub sshopen3 {
- my($host,$writer,$reader,$error,$command)=@_;
- open3($writer,$reader,$error,$ssh,'-o','Batchmode yes',$host,$command);
-}
-
-sub _yesno {
- print "Proceed [y/N]:";
- my($x)=scalar(<STDIN>);
- $x =~ /^y/i;
-}
-
-=head1 BUGS
-
-Not OO.
-
-scp stuff should transparantly use rsync-over-ssh instead.
-
-=head1 SEE ALSO
-
-L<ssh>, L<scp>, L<IPC::Open2>, L<IPC::Open3>
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-17
-
-added sshopen2 and sshopen3 ivan@sisd.com 98-mar-9
-
-added iscp ivan@sisd.com 98-jul-25
-now iscp asks y/n, issh and took out path ivan@sisd.com 98-jul-30
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::UID;
-
-use strict;
-use vars qw(
- @ISA @EXPORT_OK $cgi $dbh $freeside_uid $conf $datasrc $db_user $db_pass
-);
-use Exporter;
-use Carp;
-use DBI;
-use FS::Conf;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
- adminsuidsetup getotaker dbh datasrc);
-
-$freeside_uid = scalar(getpwnam('freeside'));
-
-my $conf = new FS::Conf;
-($datasrc, $db_user, $db_pass) = $conf->config('secrets')
- or die "Can't get secrets: $!";
-
-=head1 NAME
-
-FS::UID - Subroutines for database login and assorted other stuff
-
-=head1 SYNOPSIS
-
- use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
- checkeuid checkruid swapuid);
-
- adminsuidsetup;
-
- $cgi = new CGI::Base;
- $cgi->get;
- $dbh = cgisuidsetup($cgi);
-
- $dbh = dbh;
-
- $datasrc = datasrc;
-
-=head1 DESCRIPTION
-
-Provides a hodgepodge of subroutines.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item adminsuidsetup
-
-Cleans the environment.
-Make sure the script is running as freeside, or setuid freeside.
-Opens a connection to the database.
-Swaps real and effective UIDs.
-Returns the DBI database handle (usually you don't need this).
-
-=cut
-
-sub adminsuidsetup {
-
- $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
- $ENV{'SHELL'} = '/bin/sh';
- $ENV{'IFS'} = " \t\n";
- $ENV{'CDPATH'} = '';
- $ENV{'ENV'} = '';
- $ENV{'BASH_ENV'} = '';
-
- croak "Not running uid freeside!" unless checkeuid();
- $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- # hack for web demo
- # my($user)=getotaker();
- # $dbh = DBI->connect("$datasrc:$user",$db_user,$db_pass, {
- 'AutoCommit' => 'true',
- 'ChopBlanks' => 'true',
- } ) or die "DBI->connect error: $DBI::errstr\n";;
-
- swapuid(); #go to non-privledged user if running setuid freeside
-
- $dbh;
-}
-=item cgisuidsetup CGI::Base_OBJECT
-
-Stores the CGI::Base_OBJECT for later use.
-Runs adminsuidsetup.
-
-=cut
-
-sub cgisuidsetup {
- $cgi=$_[0];
- adminsuidsetup;
-}
-
-=item dbh
-
-Returns the DBI database handle.
-
-=cut
-
-sub dbh {
- $dbh;
-}
-
-=item datasrc
-
-Returns the DBI data source.
-
-=cut
-
-sub datasrc {
- $datasrc;
-}
-
-#hack for web demo
-#sub setdbh {
-# $dbh=$_[0];
-#}
-
-sub suidsetup {
- croak "suidsetup depriciated";
-}
-
-=item getotaker
-
-Returns the current Freeside user. Currently that means the CGI REMOTE_USER,
-or 'freeside'.
-
-=cut
-
-sub getotaker {
- if ($cgi && defined $cgi->var('REMOTE_USER')) {
- return $cgi->var('REMOTE_USER'); #for now
- } else {
- 'freeside';
- }
-}
-
-=item checkeuid
-
-Returns true if effective UID is that of the freeside user.
-
-=cut
-
-sub checkeuid {
- ( $> == $freeside_uid );
-}
-
-=item checkruid
-
-Returns true if the real UID is that of the freeside user.
-
-=cut
-
-sub checkruid {
- ( $< == $freeside_uid );
-}
-
-=item swapuid
-
-Swaps real and effective UIDs.
-
-=cut
-
-sub swapuid {
- ($<,$>) = ($>,$<);
-}
-
-=back
-
-=head1 BUGS
-
-Not OO.
-
-No capabilities yet. When mod_perl and Authen::DBI are implemented,
-cgisuidsetup will go away as well.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<CGI::Base>, L<DBI>
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jun-4 - 9
-
-untaint otaker ivan@voicenet.com 97-jul-7
-
-generalize and auto-get uid (getotaker still needs to be db'ed)
-ivan@sisd.com 97-nov-10
-
-&cgisuidsetup logs into database. other cleaning.
-ivan@sisd.com 97-nov-22,23
-
-&adminsuidsetup logs into database with otaker='freeside' (for
-automated tasks like billing)
-ivan@sisd.com 97-dec-13
-
-added sub datasrc for fs-setup ivan@sisd.com 98-feb-21
-
-datasrc, user and pass now come from conf/secrets ivan@sisd.com 98-jun-28
-
-added ChopBlanks to DBI call (see man DBI) ivan@sisd.com 98-aug-16
-
-pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
-inlined suidsetup
-ivan@sisd.com 98-sep-12
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::agent;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::agent - Object methods for agent records
-
-=head1 SYNOPSIS
-
- use FS::agent;
-
- $record = create FS::agent \%hash;
- $record = create FS::agent { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::agent object represents an agent. Every customer has an agent. Agents
-can be used to track things like resellers or salespeople. FS::agent inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item agemtnum - primary key (assigned automatically for new agents)
-
-=item agent - Text name of this agent
-
-=item typenum - Agent type. See L<FS::agent_type>
-
-=item prog - For future use.
-
-=item freq - For future use.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new agent. To add the agent to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent',$hashref);
-}
-
-=item insert
-
-Adds this agent to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this agent from the database. Only agents with no customers can be
-deleted. If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't delete an agent with customers!"
- if qsearch('cust_main',{'agentnum' => $self->agentnum});
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an agent record!" unless $old->table eq "agent";
- return "Can't change agentnum!"
- unless $old->getfield('agentnum') eq $new->getfield('agentnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid agent. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a agent record!" unless $self->table eq "agent";
-
- my($error)=
- $self->ut_numbern('agentnum')
- or $self->ut_text('agent')
- or $self->ut_number('typenum')
- or $self->ut_numbern('freq')
- or $self->ut_textn('prog')
- ;
- return $error if $error;
-
- return "Unknown typenum!"
- unless qsearchs('agent_type',{'typenum'=> $self->getfield('typenum') });
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent_type>, L<FS::cust_main>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-Class dealing with agent (resellers)
-
-ivan@sisd.com 97-nov-13, 97-dec-10
-
-pod, added check in ->delete ivan@sisd.com 98-sep-22
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::agent_type;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(qsearch fields);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::agent_type - Object methods for agent_type records
-
-=head1 SYNOPSIS
-
- use FS::agent_type;
-
- $record = create FS::agent_type \%hash;
- $record = create FS::agent_type { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::agent_type object represents an agent type. Every agent (see
-L<FS::agent>) has an agent type. Agent types define which packages (see
-L<FS::part_pkg>) may be purchased by customers (see L<FS::cust_main>), via
-FS::type_pkgs records (see L<FS::type_pkgs>). FS::agent_type inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typenum - primary key (assigned automatically for new agent types)
-
-=item atype - Text name of this agent type
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new agent type. To add the agent type to the database, see
-L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent_type')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent_type',$hashref);
-
-}
-
-=item insert
-
-Adds this agent type to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this agent type from the database. Only agent types with no agents
-can be deleted. If there is an error, returns the error, otherwise returns
-false.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't delete an agent_type with agents!"
- if qsearch('agent',{'typenum' => $self->typenum});
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a agent_type record!" unless $old->table eq "agent_type";
- return "Can't change typenum!"
- unless $old->getfield('typenum') eq $new->getfield('typenum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid agent type. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a agent_type record!" unless $self->table eq "agent_type";
-
- $self->ut_numbern('typenum')
- or $self->ut_text('atype');
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::agent>, L<FS::type_pkgs>, L<FS::cust_main>,
-L<FS::part_pkg>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-Class for the different sets of allowable packages you can assign to an
-agent.
-
-ivan@sisd.com 97-nov-13
-
-ut_ FS::Record methods
-ivan@sisd.com 97-dec-10
-
-Changed 'type' to 'atype' because Pg6.3 reserves the type word
- bmccane@maxbaud.net 98-apr-3
-
-pod, added check in delete ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_bill;
-
-use strict;
-use vars qw(@ISA $conf $add1 $add2 $add3 $add4);
-use Exporter;
-use Date::Format;
-use FS::Record qw(fields qsearch qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-
-$conf = new FS::Conf;
-
-($add1,$add2,$add3,$add4) = $conf->config('address');
-
-=head1 NAME
-
-FS::cust_bill - Object methods for cust_bill records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill;
-
- $record = create FS::cust_bill \%hash;
- $record = create FS::cust_bill { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
-
- @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
-
- ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
-
- @cust_pay_objects = $cust_bill->cust_pay;
-
- @lines = $cust_bill->print_text;
- @lines = $cust_bill->print_text $time;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill object represents an invoice. FS::cust_bill inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item invnum - primary key (assigned automatically for new invoices)
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item charged - amount of this invoice
-
-=item owed - amount still outstanding on this invoice, which is charged minus
-all payments (see L<FS::cust_pay>).
-
-=item printed - how many times this invoice has been printed automatically
-(see L<FS::cust_main/"collect">).
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new invoice. To add the invoice to the database, see L<"insert">.
-Invoices are normally created by calling the bill method of a customer object
-(see L<FS::cust_main>).
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill',$hashref);
-}
-
-=item insert
-
-Adds this invoice to the database ("Posts" the invoice). If there is an error,
-returns the error, otherwise returns false.
-
-When adding new invoices, owed must be charged (or null, in which case it is
-automatically set to charged).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->setfield('owed',$self->charged) if $self->owed eq '';
- return "owed != charged!"
- unless $self->owed == $self->charged;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. I don't remove invoices because there would then be
-no record you ever posted this invoice (which is bad, no?)
-
-=cut
-
-sub delete {
- return "Can't remove invoice!"
- #my($self)=@_;
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Only owed and printed may be changed. Owed is normally updated by creating and
-inserting a payment (see L<FS::cust_pay>). Printed is normally updated by
-calling the collect method of a customer object (see L<FS::cust_main>).
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_bill record!" unless $old->table eq "cust_bill";
- return "Can't change invnum!"
- unless $old->getfield('invnum') eq $new->getfield('invnum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change _date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change charged!"
- unless $old->getfield('charged') eq $new->getfield('charged');
- return "(New) owed can't be > (new) charged!"
- if $new->getfield('owed') > $new->getfield('charged');
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid invoice. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_bill record!" unless $self->table eq "cust_bill";
- my($recref) = $self->hashref;
-
- $recref->{invnum} =~ /^(\d*)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- #$recref->{charged} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} = $1;
-
- $recref->{owed} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal owed";
- $recref->{owed} = $1;
-
- $recref->{printed} =~ /^(\d*)$/ or return "Illegal printed";
- $recref->{printed} = $1 || '0';
-
- ''; #no error
-}
-
-=item previous
-
-Returns a list consisting of the total previous balance for this customer,
-followed by the previous outstanding invoices (as FS::cust_bill objects also).
-
-=cut
-
-sub previous {
- my($self)=@_;
- my($total)=0;
- my(@cust_bill) = sort { $a->_date <=> $b->_date }
- grep { $_->owed != 0 && $_->_date < $self->_date }
- qsearch('cust_bill',{ 'custnum' => $self->custnum } )
- ;
- foreach (@cust_bill) { $total += $_->owed; }
- $total, @cust_bill;
-}
-
-=item cust_bill_pkg
-
-Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
-
-=cut
-
-sub cust_bill_pkg {
- my($self)=@_;
- qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
-}
-
-=item cust_credit
-
-Returns a list consisting of the total previous credited (see
-L<FS::cust_credit>) for this customer, followed by the previous outstanding
-credits (FS::cust_credit objects).
-
-=cut
-
-sub cust_credit {
- my($self)=@_;
- my($total)=0;
- my(@cust_credit) = sort { $a->_date <=> $b->date }
- grep { $_->credited != 0 && $_->_date < $self->_date }
- qsearch('cust_credit', { 'custnum' => $self->custnum } )
- ;
- foreach (@cust_credit) { $total += $_->credited; }
- $total, @cust_credit;
-}
-
-=item cust_pay
-
-Returns all payments (see L<FS::cust_pay>) for this invoice.
-
-=cut
-
-sub cust_pay {
- my($self)=@_;
- sort { $a->_date <=> $b->date }
- qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
- ;
-}
-
-=item print_text [TIME];
-
-Returns an ASCII invoice, as a list of lines.
-
-TIME an optional value used to control the printing of overdue messages. The
-default is now. It isn't the date of the invoice; that's the `_date' field.
-It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=cut
-
-sub print_text {
-
- my($self,$today)=@_;
- $today ||= time;
- my($invnum)=$self->invnum;
- my($cust_main) = qsearchs('cust_main',
- { 'custnum', $self->custnum } );
- $cust_main->setfield('payname',
- $cust_main->first. ' '. $cust_main->getfield('last')
- ) unless $cust_main->payname;
-
- my($pr_total,@pr_cust_bill) = $self->previous; #previous balance
- my($cr_total,@cr_cust_credit) = $self->cust_credit; #credits
- my($balance_due) = $self->owed + $pr_total - $cr_total;
-
- #overdue?
- my($overdue) = (
- $balance_due > 0
- && $today > $self->_date
- && $self->printed > 1
- );
-
- #printing bits here
-
- local($SIG{CHLD}) = sub { wait() };
- $|=1;
- my($pid)=open(CHILD,"-|");
- die "Can't fork: $!" unless defined($pid);
-
- if ($pid) { #parent
- my(@collect)=<CHILD>;
- close CHILD;
- return @collect;
- } else { #child
-
- my($description,$amount);
- my(@buf);
-
- #define format stuff
- $%=0;
- $= = 35;
- local($^L) = <<END;
-
-
-
-
-
-
-
-END
-
- #format address
- my($l,@address)=(0,'','','','','');
- $address[$l++]=$cust_main->company if $cust_main->company;
- $address[$l++]=$cust_main->address1;
- $address[$l++]=$cust_main->address2 if $cust_main->address2;
- $address[$l++]=$cust_main->city. ", ". $cust_main->state. " ".
- $cust_main->zip;
- $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
-
- #previous balance
- foreach ( @pr_cust_bill ) {
- push @buf, (
- "Previous Balance, Invoice #". $_->invnum.
- " (". time2str("%x",$_->_date). ")",
- '$'. sprintf("%10.2f",$_->owed)
- );
- }
- if (@pr_cust_bill) {
- push @buf,('','-----------');
- push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
- push @buf,('','');
- }
-
- #new charges
- foreach ( $self->cust_bill_pkg ) {
-
- if ( $_->pkgnum ) {
-
- my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
- my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
- my($pkg)=$part_pkg->pkg;
-
- push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) )
- if $_->setup != 0;
- push @buf, (
- "$pkg (" . time2str("%x",$_->sdate) . " - " .
- time2str("%x",$_->edate) . ")",
- '$' . sprintf("%10.2f",$_->recur)
- ) if $_->recur != 0;
-
- } else { #pkgnum Tax
- push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
- if $_->setup != 0;
- }
- }
-
- push @buf,('','-----------');
- push @buf,('Total New Charges',
- '$' . sprintf("%10.2f",$self->charged) );
- push @buf,('','');
-
- push @buf,('','-----------');
- push @buf,('Total Charges',
- '$' . sprintf("%10.2f",$self->charged + $pr_total) );
- push @buf,('','');
-
- #credits
- foreach ( @cr_cust_credit ) {
- push @buf,(
- "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
- '$' . sprintf("%10.2f",$_->credited)
- );
- }
-
- #get & print payments
- foreach ( $self->cust_pay ) {
- push @buf,(
- "Payment received ". time2str("%x",$_->_date ),
- '$' . sprintf("%10.2f",$_->paid )
- );
- }
-
- #balance due
- push @buf,('','-----------');
- push @buf,('Balance Due','$' .
- sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
-
- #now print
-
- my($tot_pages)=int(scalar(@buf)/30); #15 lines, 2 values per line
- $tot_pages++ if scalar(@buf) % 30;
-
- while (@buf) {
- $description=shift(@buf);
- $amount=shift(@buf);
- write;
- }
- ($description,$amount)=('','');
- write while ( $- );
- print $^L;
-
- exit; #kid
-
- format STDOUT_TOP =
-
- @|||||||||||||||||||
- "Invoice"
- @||||||||||||||||||| @<<<<<<< @<<<<<<<<<<<
-{
- ( $tot_pages != 1 ) ? "Page $% of $tot_pages" : '',
- time2str("%x",( $self->_date )), "FS-$invnum"
-}
-
-
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add1
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add2
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add3
-@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-$add4
-
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-{ $cust_main->payname,
- ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo )
- ? "P.O. #". $cust_main->payinfo : ''
-}
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[0],''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[1],$overdue ? "* This invoice is now PAST DUE! *" : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[2],$overdue ? " Please forward payment promptly " : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[3],$overdue ? "to avoid interruption of service." : ''
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$address[4],''
-
-
-
-.
-
- format STDOUT =
- @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
- $description,$amount
-.
-
- } #endchild
-
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-It doesn't properly override FS::Record yet.
-
-print_text formatting (and some logic :/) is in source as a format declaration,
-which needs to be slurped in from a file. the fork is rather kludgy as well.
-It could be cleaned with swrite from man perlform, and the picture could be
-put in a /var/spool/freeside/conf file. Also number of lines ($=).
-
-missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style
-or something similar so the look can be completely customized?)
-
-There is an off-by-one error in print_text which causes a visual error: "Page 1
-of 2" printed on some single-page invoices?
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_pay>, L<FS::cust_bill_pkg>,
-L<FS::cust_credit>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1
-
-small fix for new API ivan@sisd.com 98-mar-14
-
-charges can be negative ivan@sisd.com 98-jul-13
-
-pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_bill_pkg;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_bill_pkg - Object methods for cust_bill_pkg records
-
-=head1 SYNOPSIS
-
- use FS::cust_bill_pkg;
-
- $record = create FS::cust_bill_pkg \%hash;
- $record = create FS::cust_bill_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_bill_pkg object represents an invoice line item.
-FS::cust_bill_pkg inherits from FS::Record. The following fields are currently
-supported:
-
-=over 4
-
-=item invnum - invoice (see L<FS::cust_bill>)
-
-=item pkgnum - package (see L<FS::cust_pkg>)
-
-=item setup - setup fee
-
-=item recur - recurring fee
-
-=item sdate - starting date of recurring fee
-
-=item edate - ending date of recurring fee
-
-=back
-
-sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also
-see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new line item. To add the line item to the database, see
-L<"insert">. Line items are normally created by calling the bill method of a
-customer object (see L<FS::cust_main>).
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill_pkg',$hashref);
-
-}
-
-=item insert
-
-Adds this line item to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. I don't remove line items because there would then be
-no record the items ever existed (which is bad, no?)
-
-=cut
-
-sub delete {
- return "Can't delete cust_bill_pkg records!";
- #my($self)=@_;
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented. This would be even more of an accounting nightmare
-than deleteing the items. Just don't do it.
-
-=cut
-
-sub replace {
- return "Can't modify cust_bill_pkg records!";
- #my($new,$old)=@_;
- #return "(Old) Not a cust_bill_pkg record!"
- # unless $old->table eq "cust_bill_pkg";
- #
- #$new->check or
- #$new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid line item. If there is an
-error, returns the error, otherwise returns false. Called by the insert
-method.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_bill_pkg record!" unless $self->table eq "cust_bill_pkg";
-
- my($error)=
- $self->ut_number('pkgnum')
- or $self->ut_number('invnum')
- or $self->ut_money('setup')
- or $self->ut_money('recur')
- or $self->ut_numbern('sdate')
- or $self->ut_numbern('edate')
- ;
- return $error if $error;
-
- if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
- return "Unknown pkgnum ".$self->pkgnum
- unless qsearchs('cust_pkg',{'pkgnum'=> $self->pkgnum });
- }
-
- return "Unknown invnum"
- unless qsearchs('cust_bill',{'invnum'=> $self->invnum });
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
-from the base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 98-mar-13
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_credit;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_credit - Object methods for cust_credit records
-
-=head1 SYNOPSIS
-
- use FS::cust_credit;
-
- $record = create FS::cust_credit \%hash;
- $record = create FS::cust_credit { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_credit object represents a credit. FS::cust_credit inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item crednum - primary key (assigned automatically for new credits)
-
-=item custnum - customer (see L<FS::cust_main>)
-
-=item amount - amount of the credit
-
-=item credited - how much of this credit that is still outstanding, which is
-amount minus all refunds (see L<FS::cust_refund>).
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
-
-=item reason - text
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new credit. To add the credit to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_credit')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_credit',$hashref);
-}
-
-=item insert
-
-Adds this credit to the database ("Posts" the credit). If there is an error,
-returns the error, otherwise returns false.
-
-When adding new invoices, credited must be amount (or null, in which case it is
-automatically set to amount).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->setfield('credited',$self->amount) if $self->credited eq '';
- return "credited != amount!"
- unless $self->credited == $self->amount;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't remove credit!"
- #my($self)=@_;
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Only credited may be changed. Credited is normally updated by creating and
-inserting a refund (see L<FS::cust_refund>).
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_credit record!" unless $old->table eq "cust_credit";
- return "Can't change crednum!"
- unless $old->getfield('crednum') eq $new->getfield('crednum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change amount!"
- unless $old->getfield('amount') eq $new->getfield('amount');
- return "(New) credited can't be > (new) amount!"
- if $new->getfield('credited') > $new->getfield('amount');
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid credit. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_credit record!" unless $self->table eq "cust_credit";
- my($recref) = $self->hashref;
-
- $recref->{crednum} =~ /^(\d*)$/ or return "Illegal crednum";
- $recref->{crednum} = $1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- $recref->{amount} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal amount";
- $recref->{amount} = $1;
-
- $recref->{credited} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal credited";
- $recref->{credited} = $1;
-
- #$recref->{otaker} =~ /^(\w+)$/ or return "Illegal otaker";
- #$recref->{otaker} = $1;
- $self->otaker(getotaker);
-
- $self->ut_textn('reason');
-
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 98-mar-17
-
-pod, otaker from FS::UID ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-#this is so kludgy i'd be embarassed if it wasn't cybercash's fault
-package main;
-use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
-
-package FS::cust_main;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $conf $lpr $processor $xaction $E_NoErr);
-use Safe;
-use Exporter;
-use Carp;
-use Time::Local;
-use Date::Format;
-use Date::Manip;
-use Business::CreditCard;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearchs qsearch);
-use FS::cust_pkg;
-use FS::cust_bill;
-use FS::cust_bill_pkg;
-use FS::cust_pay;
-#use FS::cust_pay_batch;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-$conf = new FS::Conf;
-$lpr = $conf->config('lpr');
-
-if ( $conf->exists('cybercash3.2') ) {
- require CCMckLib3_2;
- #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
- require CCMckDirectLib3_2;
- #qw(SendCC2_1Server);
- require CCMckErrno3_2;
- #qw(MCKGetErrorMessage $E_NoErr);
- import CCMckErrno3_2 qw($E_NoErr);
- my $merchant_conf;
- ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
- my $status = &CCMckLib3_2::InitConfig($merchant_conf);
- if ( $status != $E_NoErr ) {
- warn "CCMckLib3_2::InitConfig error:\n";
- foreach my $key (keys %CCMckLib3_2::Config) {
- warn " $key => $CCMckLib3_2::Config{$key}\n"
- }
- my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
- die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
- }
- $processor='cybercash3.2';
-} elsif ( $conf->exists('cybercash2') ) {
- require CCLib;
- #qw(sendmserver);
- ( $main::paymentserverhost,
- $main::paymentserverport,
- $main::paymentserversecret,
- $xaction,
- ) = $conf->config('cybercash2');
- $processor='cybercash2';
-}
-
-=head1 NAME
-
-FS::cust_main - Object methods for cust_main records
-
-=head1 SYNOPSIS
-
- use FS::cust_main;
-
- $record = create FS::cust_main \%hash;
- $record = create FS::cust_main { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- @cust_pkg = $record->all_pkgs;
-
- @cust_pkg = $record->ncancelled_pkgs;
-
- $error = $record->bill;
- $error = $record->bill %options;
- $error = $record->bill 'time' => $time;
-
- $error = $record->collect;
- $error = $record->collect %options;
- $error = $record->collect 'invoice_time' => $time,
- 'batch_card' => 'yes',
- 'report_badcard' => 'yes',
- ;
-
-=head1 DESCRIPTION
-
-An FS::cust_main object represents a customer. FS::cust_main inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item custnum - primary key (assigned automatically for new customers)
-
-=item agentnum - agent (see L<FS::agent>)
-
-=item refnum - referral (see L<FS::part_referral>)
-
-=item first - name
-
-=item last - name
-
-=item ss - social security number (optional)
-
-=item company - (optional)
-
-=item address1
-
-=item address2 - (optional)
-
-=item city
-
-=item county - (optional, see L<FS::cust_main_county>)
-
-=item state - (see L<FS::cust_main_county>)
-
-=item zip
-
-=item country - (see L<FS::cust_main_county>)
-
-=item daytime - phone (optional)
-
-=item night - phone (optional)
-
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
-
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
-
-=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
-
-=item payname - name on card or billing name
-
-=item tax - tax exempt, empty or `Y'
-
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new customer. To add the customer to the database, see L<"insert">.
-
-Note that this stores the hash reference, not a distinct copy of the hash it
-points to. You can ask the object for a copy with the I<hash> method.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my $field;
- #foreach $field (fields('cust_main')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main',$hashref);
-}
-
-=item insert
-
-Adds this customer to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- #no callbacks in check, only data checks
- #local $SIG{HUP} = 'IGNORE';
- #local $SIG{INT} = 'IGNORE';
- #local $SIG{QUIT} = 'IGNORE';
- #local $SIG{TERM} = 'IGNORE';
- #local $SIG{TSTP} = 'IGNORE';
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. Maybe cancel all of this customer's
-packages (cust_pkg)?
-
-I don't remove the customer record in the database because there would then
-be no record the customer ever existed (which is bad, no?)
-
-=cut
-
-# Usage: $error = $record -> delete;
-sub delete {
- return "Can't (yet?) delete customers.";
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main record!" unless $old->table eq "cust_main";
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid customer record. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and repalce methods.
-
-=cut
-
-sub check {
- my($self)=@_;
-
- return "Not a cust_main record!" unless $self->table eq "cust_main";
-
- my $error =
- $self->ut_number('agentnum')
- || $self->ut_number('refnum')
- || $self->ut_textn('company')
- || $self->ut_text('address1')
- || $self->ut_textn('address2')
- || $self->ut_text('city')
- || $self->ut_textn('county')
- || $self->ut_text('state')
- || $self->ut_phonen('daytime')
- || $self->ut_phonen('night')
- || $self->ut_phonen('fax')
- ;
- return $error if $error;
-
- return "Unknown agent"
- unless qsearchs('agent',{'agentnum'=>$self->agentnum});
-
- return "Unknown referral"
- unless qsearchs('part_referral',{'refnum'=>$self->refnum});
-
- $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
- $self->setfield('last',$1);
-
- $self->first =~ /^([\w \,\.\-\']+)$/ or return "Illegal first name";
- $self->first($1);
-
- if ( $self->ss eq '' ) {
- $self->ss('');
- } else {
- my $ss = $self->ss;
- $ss =~ s/\D//g;
- $ss =~ /^(\d{3})(\d{2})(\d{4})$/
- or return "Illegal social security number";
- $self->ss("$1-$2-$3");
- }
-
- return "Unknown state/county/country"
- unless qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- } );
-
- #int'l zips?
- $self->zip =~ /^(\d{5}(-\d{4})?)$/ or return "Illegal zip";
- $self->zip($1);
-
- #int'l countries!
- $self->country =~ /^(US)$/ or return "Illegal country";
- $self->country($1);
-
- $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $self->payby($1);
-
- if ( $self->payby eq 'CARD' ) {
-
- my $payinfo = $self->payinfo;
- $payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
- or return "Illegal credit card number";
- $payinfo = $1;
- $self->payinfo($payinfo);
- validate($payinfo) or return "Illegal credit card number";
- my $type = cardtype($payinfo);
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
-
- } elsif ( $self->payby eq 'BILL' ) {
-
- $self->payinfo =~ /^([\w \-]*)$/ or return "Illegal P.O. number";
- $self->payinfo($1);
-
- } elsif ( $self->payby eq 'COMP' ) {
-
- $self->payinfo =~ /^(\w{2,8})$/ or return "Illegal comp account issuer";
- $self->payinfo($1);
-
- }
-
- if ( $self->paydate eq '' ) {
- return "Expriation date required" unless $self->payby eq 'BILL';
- $self->paydate('');
- } else {
- $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
- or return "Illegal expiration date";
- if ( length($2) == 4 ) {
- $self->paydate("$2-$1-01");
- } elsif ( $2 > 97 ) { #should pry change to check for "this year"
- $self->paydate("19$2-$1-01");
- } else {
- $self->paydate("20$2-$1-01");
- }
- }
-
- if ( $self->payname eq '' ) {
- $self->payname( $self->first. " ". $self->getfield('last') );
- } else {
- $self->payname =~ /^([\w \,\.\-\']+)$/
- or return "Illegal billing name";
- $self->payname($1);
- }
-
- $self->tax =~ /^(Y?)$/ or return "Illegal tax";
- $self->tax($1);
-
- $self->otaker(getotaker);
-
- ''; #no error
-}
-
-=item all_pkgs
-
-Returns all packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub all_pkgs {
- my($self)=@_;
- qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
-}
-
-=item ncancelled_pkgs
-
-Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub ncancelled_pkgs {
- my($self)=@_;
- qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => '',
- });
-}
-
-=item bill OPTIONS
-
-Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
-conjunction with the collect method.
-
-The only currently available option is `time', which bills the customer as if
-it were that time. It is specified as a UNIX timestamp; see
-L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub bill {
- my($self,%options)=@_;
- my($time) = $options{'time'} || $^T;
-
- my($error);
-
- #put below somehow?
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- # find the packages which are due for billing, find out how much they are
- # & generate invoice database.
-
- my($total_setup,$total_recur)=(0,0);
-
- my(@cust_bill_pkg);
-
- my($cust_pkg);
- foreach $cust_pkg (
- qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
- ) {
-
- bless($cust_pkg,"FS::cust_pkg");
-
- next if ( $cust_pkg->getfield('cancel') );
-
- #? to avoid use of uninitialized value errors... ?
- $cust_pkg->setfield('bill', '')
- unless defined($cust_pkg->bill);
-
- my($part_pkg)=
- qsearchs('part_pkg',{'pkgpart'=> $cust_pkg->pkgpart } );
-
- #so we don't modify cust_pkg record unnecessarily
- my($cust_pkg_mod_flag)=0;
- my(%hash)=$cust_pkg->hash;
- my($old_cust_pkg)=create FS::cust_pkg(\%hash);
-
- # bill setup
- my($setup)=0;
- unless ( $cust_pkg->setup ) {
- my($setup_prog)=$part_pkg->getfield('setup');
- my($cpt) = new Safe;
- #$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
- $setup = $cpt->reval($setup_prog);
- unless ( defined($setup) ) {
- warn "Error reval-ing part_pkg->setup pkgpart ",
- $part_pkg->pkgpart, ": $@";
- } else {
- $cust_pkg->setfield('setup',$time);
- $cust_pkg_mod_flag=1;
- }
- }
-
- #bill recurring fee
- my($recur)=0;
- my($sdate);
- if ( $part_pkg->getfield('freq') > 0 &&
- ! $cust_pkg->getfield('susp') &&
- ( $cust_pkg->getfield('bill') || 0 ) < $time
- ) {
- my($recur_prog)=$part_pkg->getfield('recur');
- my($cpt) = new Safe;
- #$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
- $recur = $cpt->reval($recur_prog);
- unless ( defined($recur) ) {
- warn "Error reval-ing part_pkg->recur pkgpart ",
- $part_pkg->pkgpart, ": $@";
- } else {
- #change this bit to use Date::Manip?
- #$sdate=$cust_pkg->bill || time;
- #$sdate=$cust_pkg->bill || $time;
- $sdate=$cust_pkg->bill || $cust_pkg->setup || $time;
- my($sec,$min,$hour,$mday,$mon,$year)=
- (localtime($sdate) )[0,1,2,3,4,5];
- $mon += $part_pkg->getfield('freq');
- until ( $mon < 12 ) { $mon -= 12; $year++; }
- $cust_pkg->setfield('bill',timelocal($sec,$min,$hour,$mday,$mon,$year));
- $cust_pkg_mod_flag=1;
- }
- }
-
- warn "setup is undefinded" unless defined($setup);
- warn "recur is undefinded" unless defined($recur);
- warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
-
- if ($cust_pkg_mod_flag) {
- $error=$cust_pkg->replace($old_cust_pkg);
- if ( $error ) {
- warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
- } else {
- #just in case
- $setup=sprintf("%.2f",$setup);
- $recur=sprintf("%.2f",$recur);
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
- 'pkgnum' => $cust_pkg->pkgnum,
- 'setup' => $setup,
- 'recur' => $recur,
- 'sdate' => $sdate,
- 'edate' => $cust_pkg->bill,
- });
- push @cust_bill_pkg, $cust_bill_pkg;
- $total_setup += $setup;
- $total_recur += $recur;
- }
- }
-
- }
-
- my($charged)=sprintf("%.2f",$total_setup + $total_recur);
-
- return '' if scalar(@cust_bill_pkg) == 0;
-
- unless ( $self->getfield('tax') eq 'Y' ||
- $self->getfield('tax') eq 'y' ||
- $self->getfield('payby') eq 'COMP'
- ) {
- my($cust_main_county) = qsearchs('cust_main_county',{
- 'county' => $self->getfield('county'),
- 'state' => $self->getfield('state'),
- } );
- my($tax) = sprintf("%.2f",
- $charged * ( $cust_main_county->getfield('tax') / 100 )
- );
- $charged = sprintf("%.2f",$charged+$tax);
-
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- });
- push @cust_bill_pkg, $cust_bill_pkg;
- }
-
- my($cust_bill) = create FS::cust_bill ( {
- 'custnum' => $self->getfield('custnum'),
- '_date' => $time,
- 'charged' => $charged,
- } );
- $error=$cust_bill->insert;
- #shouldn't happen, but how else to handle this? (wrap me in eval, to catch
- # fatal errors)
- die "Error creating cust_bill record: $error!\n",
- "Check updated but unbilled packages for customer", $self->custnum, "\n"
- if $error;
-
- my($invnum)=$cust_bill->invnum;
- my($cust_bill_pkg);
- foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->setfield('invnum',$invnum);
- $error=$cust_bill_pkg->insert;
- #shouldn't happen, but how else tohandle this?
- die "Error creating cust_bill_pkg record: $error!\n",
- "Check incomplete invoice ", $invnum, "\n"
- if $error;
- }
-
- ''; #no error
-}
-
-=item collect OPTIONS
-
-(Attempt to) collect money for this customer's outstanding invoices (see
-L<FS::cust_bill>). Usually used after the bill method.
-
-Depending on the value of `payby', this may print an invoice (`BILL'), charge
-a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
-
-If there is an error, returns the error, otherwise returns false.
-
-Currently available options are:
-
-invoice_time - Use this time when deciding when to print invoices and
-late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse>
-for conversion functions.
-
-batch_card - Set this true to batch cards (see L<cust_pay_batch>). By
-default, cards are processed immediately, which will generate an error if
-CyberCash is not installed.
-
-report_badcard - Set this true if you want bad card transactions to
-return an error. By default, they don't.
-
-=cut
-
-sub collect {
- my($self,%options)=@_;
- my($invoice_time) = $options{'invoice_time'} || $^T;
-
- my($total_owed) = $self->balance;
- return '' unless $total_owed > 0; #redundant?????
-
- #put below somehow?
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- foreach my $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
-
- #this has to be before next's
- my($amount) = sprintf("%.2f", $total_owed < $cust_bill->owed
- ? $total_owed
- : $cust_bill->owed
- );
- $total_owed = sprintf("%.2f",$total_owed-$amount);
-
- next unless $cust_bill->owed > 0;
-
- next if qsearchs('cust_pay_batch',{'invnum'=> $cust_bill->invnum });
-
- #warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)";
-
- next unless $amount > 0;
-
- if ( $self->getfield('payby') eq 'BILL' ) {
-
- #30 days 2592000
- my($since)=$invoice_time - ( $cust_bill->_date || 0 );
- #warn "$invoice_time ", $cust_bill->_date, " $since";
- if ( $since >= 0 #don't print future invoices
- && ( $cust_bill->printed * 2592000 ) <= $since
- ) {
-
- open(LPR,$lpr) or die "Can't open $lpr: $!";
- print LPR $cust_bill->print_text; #( date )
- close LPR
- or die $! ? "Error closing $lpr: $!"
- : "Exit status $? from $lpr";
-
- my(%hash)=$cust_bill->hash;
- $hash{'printed'}++;
- my($new_cust_bill)=create FS::cust_bill(\%hash);
- my($error)=$new_cust_bill->replace($cust_bill);
- if ( $error ) {
- warn "Error updating $cust_bill->printed: $error";
- }
-
- }
-
- } elsif ( $self->getfield('payby') eq 'COMP' ) {
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'COMP',
- 'payinfo' => $self->getfield('payinfo'),
- 'paybatch' => ''
- } );
- my($error)=$cust_pay->insert;
- return 'Error COMPing invnum #' . $cust_bill->getfield('invnum') .
- ':' . $error if $error;
- } elsif ( $self->getfield('payby') eq 'CARD' ) {
-
- if ( $options{'batch_card'} ne 'yes' ) {
-
- return "Real time card processing not enabled!" unless $processor;
-
- if ( $processor =~ /cybercash/ ) {
-
- #fix exp. date for cybercash
- $self->getfield('paydate') =~ /^(\d+)\/\d*(\d{2})$/;
- my($exp)="$1/$2";
-
- my($paybatch)= $cust_bill->getfield('invnum') .
- '-' . time2str("%y%m%d%H%M%S",time);
-
- my($payname)= $self->getfield('payname') ||
- $self->getfield('first') . ' ' .$self->getfield('last');
-
- my($address)= $self->getfield('address1');
- $address .= ", " . $self->getfield('address2')
- if $self->getfield('address2');
-
- my($country) = $self->getfield('country') eq 'US' ?
- 'USA' : $self->getfield('country');
-
- my(@full_xaction)=($xaction,
- 'Order-ID' => $paybatch,
- 'Amount' => "usd $amount",
- 'Card-Number' => $self->getfield('payinfo'),
- 'Card-Name' => $payname,
- 'Card-Address' => $address,
- 'Card-City' => $self->getfield('city'),
- 'Card-State' => $self->getfield('state'),
- 'Card-Zip' => $self->getfield('zip'),
- 'Card-Country' => $country,
- 'Card-Exp' => $exp,
- );
-
- my(%result);
- if ( $processor eq 'cybercash2' ) {
- $^W=0; #CCLib isn't -w safe, ugh!
- %result = &CCLib::sendmserver(@full_xaction);
- $^W=1;
- } elsif ( $processor eq 'cybercash3.2' ) {
- %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
- } else {
- return "Unkonwn real-time processor $processor\n";
- }
-
- #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
- #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
- if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'paid' => $amount,
- '_date' => '',
- 'payby' => 'CARD',
- 'payinfo' => $self->getfield('payinfo'),
- 'paybatch' => "$processor:$paybatch",
- } );
- my($error)=$cust_pay->insert;
- return 'Error applying payment, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $error if $error;
- } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
- || $options{'report_badcard'} ) {
- return 'Cybercash error, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $result{'MErrMsg'};
- } else {
- return '';
- }
-
- } else {
- return "Unkonwn real-time processor $processor\n";
- }
-
- } else { #batch card
-
-# my($cust_pay_batch) = create FS::cust_pay_batch ( {
- my($cust_pay_batch) = new FS::Record ('cust_pay_batch', {
- 'invnum' => $cust_bill->getfield('invnum'),
- 'custnum' => $self->getfield('custnum'),
- 'last' => $self->getfield('last'),
- 'first' => $self->getfield('first'),
- 'address1' => $self->getfield('address1'),
- 'address2' => $self->getfield('address2'),
- 'city' => $self->getfield('city'),
- 'state' => $self->getfield('state'),
- 'zip' => $self->getfield('zip'),
- 'country' => $self->getfield('country'),
- 'trancode' => 77,
- 'cardnum' => $self->getfield('payinfo'),
- 'exp' => $self->getfield('paydate'),
- 'payname' => $self->getfield('payname'),
- 'amount' => $amount,
- } );
-# my($error)=$cust_pay_batch->insert;
- my($error)=$cust_pay_batch->add;
- return "Error adding to cust_pay_batch: $error" if $error;
-
- }
-
- } else {
- return "Unknown payment type ".$self->getfield('payby');
- }
-
- }
- '';
-
-}
-
-=item total_owed
-
-Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill>).
-
-=cut
-
-sub total_owed {
- my($self) = @_;
- my($total_bill) = 0;
- my($cust_bill);
- foreach $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
- $total_bill += $cust_bill->getfield('owed');
- }
- sprintf("%.2f",$total_bill);
-}
-
-=item total_credited
-
-Returns the total credits (see L<FS::cust_credit>) for this customer.
-
-=cut
-
-sub total_credited {
- my($self) = @_;
- my($total_credit) = 0;
- my($cust_credit);
- foreach $cust_credit ( qsearch('cust_credit', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
- $total_credit += $cust_credit->getfield('credited');
- }
- sprintf("%.2f",$total_credit);
-}
-
-=item balance
-
-Returns the balance for this customer (total owed minus total credited).
-
-=cut
-
-sub balance {
- my($self) = @_;
- sprintf("%.2f",$self->total_bill - $self->total_credit);
-}
-
-=back
-
-=head1 BUGS
-
-The delete method.
-
-It doesn't properly override FS::Record yet.
-
-hfields should be removed.
-
-Bill and collect options should probably be passed as references instead of a
-list.
-
-CyberCash v2 forces us to define some variables in package main.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
-L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
-L<FS::cust_main_county>, L<FS::UID>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-28
-
-Changed to standard Business::CreditCard
-no more TableUtil
-EXPORT_OK FS::Record's hfields
-removed unique calls and locking (not needed here now)
-wrapped the (now) optional fields in if statements in sub check (notyetdone!)
-ivan@sisd.com 97-nov-12
-
-updated paydate with SQL-type date info ivan@sisd.com 98-mar-5
-
-Added export of datasrc from UID.pm for Pg6.3
-changed 'day' to 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
-in ->create, s/svc_acct/cust_main/, now it should actually eliminate the
-warnings it was meant to ivan@sisd.com 98-jul-16
-
-don't require a phone number and allow '/' in company names
-ivan@sisd.com 98-jul-18
-
-use ut_ and rewrite &check, &*_pkgs ivan@sisd.com 98-sep-5
-
-pod, merge with FS::Bill (about time!), total_owed, total_credited and balance
-methods, cleaned collect method, source modifications no longer necessary to
-enable cybercash, cybercash v3 support, don't need to import
-FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21
-
-=cut
-
-1;
-
-
+++ /dev/null
-package FS::cust_main_county;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields qsearch qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-=head1 NAME
-
-FS::cust_main_county - Object methods for cust_main_county objects
-
-=head1 SYNOPSIS
-
- use FS::cust_main_county;
-
- $record = create FS::cust_main_county \%hash;
- $record = create FS::cust_main_county { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_main_county object represents a tax rate, defined by locale.
-FS::cust_main_county inherits from FS::Record. The following fields are
-currently supported:
-
-=over 4
-
-=item taxnum - primary key (assigned automatically for new tax rates)
-
-=item state
-
-=item county
-
-=item tax - percentage
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_main_county')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main_county',$hashref);
-}
-
-=item insert
-
-Adds this tax rate to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this tax rate from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main_county record!"
- unless $old->table eq "cust_main_county";
- return "Can't change taxnum!"
- unless $old->getfield('taxnum') eq $new->getfield('taxnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid tax rate. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_main_county record!"
- unless $self->table eq "cust_main_county";
- my($recref) = $self->hashref;
-
- $self->ut_numbern('taxnum')
- or $self->ut_text('state')
- or $self->ut_textn('county')
- or $self->ut_float('tax')
- ;
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-A country field (and possibly a currency field) should be added.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-dec-16
-
-Changed check for 'tax' to use the new ut_float subroutine
- bmccane@maxbaud.net 98-apr-3
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_pay;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
-use FS::cust_bill;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_pay - Object methods for cust_pay objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pay;
-
- $record = create FS::cust_pay \%hash;
- $record = create FS::cust_pay { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_pay object represents a payment. FS::cust_pay inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item paynum - primary key (assigned automatically for new payments)
-
-=item invnum - Invoice (see L<FS::cust_bill>)
-
-=item paid - Amount of this payment
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
-
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
-
-=item paybatch - text field for tracking card processing
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new payment. To add the payment to the databse, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pay')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pay',$hashref);
-
-}
-
-=item insert
-
-Adds this payment to the databse, and updates the invoice (see
-L<FS::cust_bill>).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- my($error);
-
- $error=$self->check;
- return $error if $error;
-
- my($old_cust_bill) = qsearchs('cust_bill', {
- 'invnum' => $self->getfield('invnum')
- } );
- return "Unknown invnum" unless $old_cust_bill;
- my(%hash)=$old_cust_bill->hash;
- $hash{owed} = sprintf("%.2f",$hash{owed} - $self->getfield('paid') );
- my($new_cust_bill) = create FS::cust_bill ( \%hash );
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$new_cust_bill -> replace($old_cust_bill);
- return "Error modifying cust_bill: $error" if $error;
-
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete cust_pay records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub replace {
- return "Can't (yet?) modify cust_pay records!";
-#template code below
-# my($new,$old)=@_;
-# return "(Old) Not a cust_pay record!" unless $old->table eq "cust_pay";
-#
-# $new->check or
-# $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid payment. If there is an error,
-returns the error, otherwise returns false. Called by the insert method.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_pay record!" unless $self->table eq "cust_pay";
- my($recref) = $self->hashref;
-
- $recref->{paynum} =~ /^(\d*)$/ or return "Illegal paynum";
- $recref->{paynum} = $1;
-
- $recref->{invnum} =~ /^(\d+)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
-
- $recref->{paid} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal paid";
- $recref->{paid} = $1;
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
-
- if ( $recref->{payby} eq 'CARD' ) {
-
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
- or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal credit card number";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
- } else {
- $recref->{payinfo}='N/A';
- }
-
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
- }
-
- $recref->{paybatch} =~ /^([\w\-\:]*)$/
- or return "Illegal paybatch";
- $recref->{paybatch} = $1;
-
- ''; #no error
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_bill>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1 - 25 - 29
-
-new api ivan@sisd.com 98-mar-13
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_pkg;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
-
-@ISA = qw(FS::Record Exporter);
-
-=head1 NAME
-
-FS::cust_pkg - Object methods for cust_pkg objects
-
-=head1 SYNOPSIS
-
- use FS::cust_pkg;
-
- $record = create FS::cust_pkg \%hash;
- $record = create FS::cust_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->cancel;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = FS::cust_pkg::order( $custnum, \@pkgparts );
- $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
-
-=head1 DESCRIPTION
-
-An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgnum - primary key (assigned automatically for new billing items)
-
-=item custnum - Customer (see L<FS::cust_main>)
-
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
-
-=item setup - date
-
-=item bill - date
-
-=item susp - date
-
-=item expire - date
-
-=item cancel - date
-
-=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
-
-=back
-
-Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
-see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
-conversion functions.
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Create a new billing item. To add the item to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pkg',$hashref);
-}
-
-=item insert
-
-Adds this billing item to the database ("Orders" the item). If there is an
-error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented. You don't want to delete billing items, because there
-would then be no record the customer ever purchased the item. Instead, see
-the cancel method.
-
-sub delete {
- return "Can't delete cust_pkg records!";
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
-
-pkgpart may not be changed, but see the order subroutine.
-
-setup and bill are normally updated by calling the bill method of a customer
-object (see L<FS::cust_main>).
-
-suspend is normally updated by the suspend and unsuspend methods.
-
-cancel is normally updated by the cancel method (and also the order subroutine
-in some cases).
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
- return "Can't change pkgnum!"
- if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
- return "Can't (yet?) change pkgpart!"
- if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change otaker!"
- if $old->getfield('otaker') ne $new->getfield('otaker');
- return "Can't change setup once it exists!"
- if $old->getfield('setup') &&
- $old->getfield('setup') != $new->getfield('setup');
- #some logic for bill, susp, cancel?
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid billing item. If there is an
-error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
- my($recref) = $self->hashref;
-
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum}=$1;
- return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart}=$1;
- return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
-
- $recref->{otaker} ||= &getotaker;
- $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
- $recref->{otaker}=$1;
-
- $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
- $recref->{setup}=$1;
-
- $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
- $recref->{bill}=$1;
-
- $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
- $recref->{susp}=$1;
-
- $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
- $recref->{cancel}=$1;
-
- ''; #no error
-}
-
-=item cancel
-
-Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
-in this package, then cancels the package itself (sets the cancel field to
-now).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub cancel {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
- ) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
-
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
- require "FS/$svcdb.pm";
-
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
- if ($svc) {
- bless($svc,"FS::$svcdb");
- $error = $svc->cancel;
- return "Error cancelling service: $error" if $error;
- $error = $svc->delete;
- return "Error deleting service: $error" if $error;
- }
-
- bless($cust_svc,"FS::cust_svc");
- $error = $cust_svc->delete;
- return "Error deleting cust_svc: $error" if $error;
-
- }
-
- unless ( $self->getfield('cancel') ) {
- my(%hash) = $self->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
- return $error if $error;
- }
-
- ''; #no errors
-}
-
-=item suspend
-
-Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
-package, then suspends the package itself (sets the susp field to now).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub suspend {
- my($self)=@_;
- my($error);
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
- ) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
-
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
- require "FS/$svcdb.pm";
-
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
-
- if ($svc) {
- bless($svc,"FS::$svcdb");
- $error = $svc->suspend;
- return $error if $error;
- }
-
- }
-
- unless ( $self->getfield('susp') ) {
- my(%hash) = $self->hash;
- $hash{'susp'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
- return $error if $error;
- }
-
- ''; #no errors
-}
-
-=item unsuspend
-
-Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
-package, then unsuspends the package itself (clears the susp field).
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub unsuspend {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
- ) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
-
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
- or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
- require "FS/$svcdb.pm";
-
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
- if ($svc) {
- bless($svc,"FS::$svcdb");
- $error = $svc->unsuspend;
- return $error if $error;
- }
-
- }
-
- unless ( ! $self->getfield('susp') ) {
- my(%hash) = $self->hash;
- $hash{'susp'}='';
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
- return $error if $error;
- }
-
- ''; #no errors
-}
-
-=back
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
-
-CUSTNUM is a customer (see L<FS::cust_main>)
-
-PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
-L<FS::part_pkg>) to order for this customer. Duplicates are of course
-permitted.
-
-REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
-remove for this customer. The services (see L<FS::cust_svc>) are moved to the
-new billing items. An error is returned if this is not possible (see
-L<FS::pkg_svc>).
-
-=cut
-
-sub order {
- my($custnum,$pkgparts,$remove_pkgnums)=@_;
-
- my(%part_pkg);
- # generate %part_pkg
- # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
- my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
-
- my($type_pkgs);
- foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
- my($pkgpart)=$type_pkgs->pkgpart;
- $part_pkg{$pkgpart}++;
- }
- #
-
- my(%svcnum);
- # generate %svcnum
- # for those packages being removed:
- #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
- # objects (table eq 'cust_svc')
- my($pkgnum);
- foreach $pkgnum ( @{$remove_pkgnums} ) {
- my($cust_svc);
- foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
- push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
- }
- }
-
- my(@cust_svc);
- #generate @cust_svc
- # for those packages the customer is purchasing:
- # @{$pkgparts} is a list of said packages, by pkgpart
- # @cust_svc is a corresponding list of lists of FS::Record objects
- my($pkgpart);
- foreach $pkgpart ( @{$pkgparts} ) {
- return "Customer not permitted to purchase pkgpart $pkgpart!"
- unless $part_pkg{$pkgpart};
- push @cust_svc, [
- map {
- ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
- } (split(/,/,
- qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
- ))
- ];
- }
-
- #check for leftover services
- foreach (keys %svcnum) {
- next unless @{ $svcnum{$_} };
- return "Leftover services!";
- }
-
- #no leftover services, let's make changes.
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- #first cancel old packages
-# my($pkgnum);
- foreach $pkgnum ( @{$remove_pkgnums} ) {
- my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
- return "Package $pkgnum not found to remove!" unless $old;
- my(%hash) = $old->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- my($error)=$new->replace($old);
- return $error if $error;
- }
-
- #now add new packages, changing cust_svc records if necessary
-# my($pkgpart);
- while ($pkgpart=shift @{$pkgparts} ) {
-
- my($new) = create FS::cust_pkg ( {
- 'custnum' => $custnum,
- 'pkgpart' => $pkgpart,
- } );
- my($error) = $new->insert;
- return $error if $error;
- my($pkgnum)=$new->getfield('pkgnum');
-
- my($cust_svc);
- foreach $cust_svc ( @{ shift @cust_svc } ) {
- my(%hash) = $cust_svc->hash;
- $hash{'pkgnum'}=$pkgnum;
- my($new) = create FS::cust_svc ( \%hash );
- my($error)=$new->replace($cust_svc);
- return $error if $error;
- }
- }
-
- ''; #no errors
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
-
-In sub order, the @pkgparts array (passed by reference) is clobbered.
-
-Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
-method to pass dates to the recur_prog expression, it should do so.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
-, L<FS::pkg_svc>, schema.html from the base documentation
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1 - 21
-
-fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_refund;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
-use FS::UID qw(getotaker);
-use FS::cust_credit;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::cust_refund - Object method for cust_refund objects
-
-=head1 SYNOPSIS
-
- use FS::cust_refund;
-
- $record = create FS::cust_refund \%hash;
- $record = create FS::cust_refund { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_refund represents a refund. FS::cust_refund inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item refundnum - primary key (assigned automatically for new refunds)
-
-=item crednum - Credit (see L<FS::cust_credit>)
-
-=item refund - Amount of the refund
-
-=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
-L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item payby - `CARD' (credit cards), `BILL' (billing), or `COMP' (free)
-
-=item payinfo - card number, P.O.#, or comp issuer (4-8 lowercase alphanumerics; think username)
-
-=item otaker - order taker (assigned automatically, see L<FS::UID>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new refund. To add the refund to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_refund')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_refund',$hashref);
-
-}
-
-=item insert
-
-Adds this refund to the database, and updates the credit (see
-L<FS::cust_credit>).
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- my($error);
-
- $error=$self->check;
- return $error if $error;
-
- my($old_cust_credit) = qsearchs('cust_credit', {
- 'crednum' => $self->getfield('crednum')
- } );
- return "Unknown crednum" unless $old_cust_credit;
- my(%hash)=$old_cust_credit->hash;
- $hash{credited} = sprintf("%.2f",$hash{credited} - $self->getfield('refund') );
- my($new_cust_credit) = create FS::cust_credit ( \%hash );
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$new_cust_credit -> replace($old_cust_credit);
- return "Error modifying cust_credit: $error" if $error;
-
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete cust_refund records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Currently unimplemented (accounting reasons).
-
-=cut
-
-sub replace {
- return "Can't (yet?) modify cust_refund records!";
-#template code below
-# my($new,$old)=@_;
-# return "(Old) Not a cust_refund record!" unless $old->table eq "cust_refund";
-#
-# $new->check or
-# $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid refund. If there is an error,
-returns the error, otherwise returns false. Called by the insert method.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_refund record!" unless $self->table eq "cust_refund";
-
- my $error =
- $self->ut_number('refundnum')
- || $self->ut_number('crednum')
- || $self->ut_money('amount')
- || $self->ut_numbern('_date')
- ;
- return $error if $error;
-
- my($recref) = $self->hashref;
-
- $recref->{_date} ||= time;
-
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
-
- if ( $recref->{payby} eq 'CARD' ) {
-
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
- or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal (checksum) credit card number (payinfo)";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
- } else {
- $recref->{payinfo}='N/A';
- }
-
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
- }
-
- $self->otaker(getotaker);
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-Delete and replace methods.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_credit>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 98-mar-18
-
-->create had wrong tablename ivan@sisd.com 98-jun-16
-(finish me!)
-
-pod and finish up ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::cust_svc;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-
-=head1 NAME
-
-FS::cust_svc - Object method for cust_svc objects
-
-=head1 SYNOPSIS
-
- use FS::cust_svc;
-
- $record = create FS::cust_svc \%hash
- $record = create FS::cust_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
-The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatically for new services)
-
-=item pkgnum - Package (see L<FS::cust_pkg>)
-
-=item svcpart - Service definition (see L<FS::part_svc>)
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new service. To add the refund to the database, see L<"insert">.
-Services are normally created by creating FS::svc_ objects (see
-L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others).
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_svc',$hashref);
-}
-
-=item insert
-
-Adds this service to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this service from the database. If there is an error, returns the
-error, otherwise returns false.
-
-Called by the cancel method of the package (see L<FS::cust_pkg>).
-
-=cut
-
-sub delete {
- my($self)=@_;
- # anything else here?
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_svc record!" unless $old->table eq "cust_svc";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service. If there is an error,
-returns the error, otehrwise returns false. Called by the insert and
-replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a cust_svc record!" unless $self->table eq "cust_svc";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum}=$1;
-
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
- return "Unknown pkgnum" unless
- ! $recref->{pkgnum} ||
- qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}});
-
- $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart";
- $recref->{svcpart}=$1;
- return "Unknown svcpart" unless
- qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}});
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-Behaviour of changing the svcpart of cust_svc records is undefined and should
-possibly be prohibited, and pkg_svc records are not checked.
-
-pkg_svc records are not checket in general (here).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
-schema.html from the base documentation
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-10,14
-
-no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef;
-
-use strict;
-use vars qw(@ISA);
-use Exporter;
-use Carp;
-use FreezeThaw qw(freeze thaw cmpStr);
-use FS::dbdef_table;
-use FS::dbdef_unique;
-use FS::dbdef_index;
-use FS::dbdef_column;
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef - Database objects
-
-=head1 SYNOPSIS
-
- use FS::dbdef;
-
- $dbdef = new FS::dbdef (@dbdef_table_objects);
- $dbdef = load FS::dbdef "filename";
-
- $dbdef->save("filename");
-
- $dbdef->addtable($dbdef_table_object);
-
- @table_names = $dbdef->tables;
-
- $FS_dbdef_table_object = $dbdef->table;
-
-=head1 DESCRIPTION
-
-FS::dbdef objects are collections of FS::dbdef_table objects and represnt
-a database (a collection of tables).
-
-=head1 METHODS
-
-=over 4
-
-=item new TABLE, TABLE, ...
-
-Creates a new FS::dbdef object
-
-=cut
-
-sub new {
- my($proto,@tables)=@_;
- my(%tables)=map { $_->name, $_ } @tables; #check for duplicates?
-
- my($class) = ref($proto) || $proto;
- my($self) = {
- 'tables' => \%tables,
- };
-
- bless ($self, $class);
-
-}
-
-=item load FILENAME
-
-Loads an FS::dbdef object from a file.
-
-=cut
-
-sub load {
- my($proto,$file)=@_; #use $proto ?
- open(FILE,"<$file") or die "Can't open $file: $!";
- my($string)=join('',<FILE>); #can $string have newlines? pry not?
- close FILE or die "Can't close $file: $!";
- my($self)=thaw $string;
- #no bless needed?
- $self;
-}
-
-=item save FILENAME
-
-Saves an FS::dbdef object to a file.
-
-=cut
-
-sub save {
- my($self,$file)=@_;
- my($string)=freeze $self;
- open(FILE,">$file") or die "Can't open $file: $!";
- print FILE $string;
- close FILE or die "Can't close file: $!";
- my($check_self)=thaw $string;
- die "Verify error: Can't freeze and thaw dbdef $self"
- if (cmpStr($self,$check_self));
-}
-
-=item addtable TABLE
-
-Adds this FS::dbdef_table object.
-
-=cut
-
-sub addtable {
- my($self,$table)=@_;
- ${$self->{'tables'}}{$table->name}=$table; #check for dupliates?
-}
-
-=item tables
-
-Returns the names of all tables.
-
-=cut
-
-sub tables {
- my($self)=@_;
- keys %{$self->{'tables'}};
-}
-
-=item table TABLENAME
-
-Returns the named FS::dbdef_table object.
-
-=cut
-
-sub table {
- my($self,$table)=@_;
- $self->{'tables'}->{$table};
-}
-
-=head1 BUGS
-
-Each FS::dbdef object should have a name which corresponds to its name within
-the SQL database engine.
-
-=head1 SEE ALSO
-
-L<FS::dbdef_table>, L<FS::Record>,
-
-=head1 HISTORY
-
-beginning of abstraction into a class (not really)
-
-ivan@sisd.com 97-dec-4
-
-added primary_key
-ivan@sisd.com 98-jan-20
-
-added datatype (very kludgy and needs to be cleaned)
-ivan@sisd.com 98-feb-21
-
-perltrap (sigh) masked by mysql 3.20->3,21 ivan@sisd.com 98-mar-2
-
-Change 'type' to 'atype' in agent_type
-Changed attributes to special words which are changed in fs-setup
- ie. double(10,2) <=> MONEYTYPE
-Changed order of some of the field definitions because Pg6.3 is picky
-Changed 'day' to 'daytime' in cust_main
-Changed type of tax from tinyint to real
-Change 'password' to '_password' in svc_acct
-Pg6.3 does not allow 'field char(x) NULL'
- bmccane@maxbaud.net 98-apr-3
-
-rewrite: now properly OO. See also FS::dbdef_{table,column,unique,index}
-
-ivan@sisd.com 98-apr-17
-
-gained some extra functions ivan@sisd.com 98-may-11
-
-now knows how to Freeze and Thaw itself ivan@sisd.com 98-jun-2
-
-pod ivan@sisd.com 98-sep-23
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_colgroup;
-
-use strict;
-use vars qw(@ISA);
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef_colgroup - Column group objects
-
-=head1 SYNOPSIS
-
- use FS::dbdef_colgroup;
-
- $colgroup = new FS::dbdef_colgroup ( $lol );
- $colgroup = new FS::dbdef_colgroup (
- [
- [ 'single_column' ],
- [ 'multiple_columns', 'another_column', ],
- ]
- );
-
- @sql_lists = $colgroup->sql_list;
-
- @singles = $colgroup->singles;
-
-=head1 DESCRIPTION
-
-FS::dbdef_colgroup objects represent sets of sets of columns.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new FS::dbdef_colgroup object.
-
-=cut
-
-sub new {
- my($proto, $lol) = @_;
-
- my $class = ref($proto) || $proto;
- my $self = {
- 'lol' => $lol,
- };
-
- bless ($self, $class);
-
-}
-
-=item sql_list
-
-Returns a flat list of comma-separated values, for SQL statements.
-
-=cut
-
-sub sql_list { #returns a flat list of comman-separates lists (for sql)
- my($self)=@_;
- grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
-}
-
-=item singles
-
-Returns a flat list of all single item lists.
-
-=cut
-
-sub singles { #returns single-field groups as a flat list
- my($self)=@_;
- #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
- map {
- ${$_}[0] =~ /^(\w+)$/
- #aah!
- or die "Illegal column ", ${$_}[0], " in colgroup!";
- $1;
- } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::dbdef_table>, L<FS::dbdef_unique>, L<FS::dbdef_index>,
-L<FS::dbdef_column>, L<FS::dbdef>, L<perldsc>
-
-=head1 HISTORY
-
-class for dealing with groups of groups of columns (used as a base class by
-FS::dbdef_{unique,index} )
-
-ivan@sisd.com 98-apr-19
-
-added singles, fixed sql_list to skip empty lists ivan@sisd.com 98-jun-2
-
-untaint things we're returning in sub singels ivan@sisd.com 98-jun-4
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_column;
-
-use strict;
-#use Carp;
-use Exporter;
-use vars qw(@ISA);
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef_column - Column object
-
-=head1 SYNOPSIS
-
- use FS::dbdef_column;
-
- $column_object = new FS::dbdef_column ( $name, $sql_type, '' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL' );
- $column_object = new FS::dbdef_column ( $name, $sql_type, '', $length );
- $column_object = new FS::dbdef_column ( $name, $sql_type, 'NULL', $length );
-
- $name = $column_object->name;
- $column_object->name ( 'name' );
-
- $name = $column_object->type;
- $column_object->name ( 'sql_type' );
-
- $name = $column_object->null;
- $column_object->name ( 'NOT NULL' );
-
- $name = $column_object->length;
- $column_object->name ( $length );
-
- $sql_line = $column->line;
- $sql_line = $column->line $datasrc;
-
-=head1 DESCRIPTION
-
-FS::dbdef::column objects represend columns in tables (see L<FS::dbdef_table>).
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new FS::dbdef_column object.
-
-=cut
-
-sub new {
- my($proto,$name,$type,$null,$length)=@_;
-
- #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
-
- $null =~ s/^NOT NULL$//i;
-
- my $class = ref($proto) || $proto;
- my $self = {
- 'name' => $name,
- 'type' => $type,
- 'null' => $null,
- 'length' => $length,
- };
-
- bless ($self, $class);
-
-}
-
-=item name
-
-Returns or sets the column name.
-
-=cut
-
-sub name {
- my($self,$value)=@_;
- if ( defined($value) ) {
- #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
- $self->{'name'} = $value;
- } else {
- $self->{'name'};
- }
-}
-
-=item type
-
-Returns or sets the column type.
-
-=cut
-
-sub type {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{'type'} = $value;
- } else {
- $self->{'type'};
- }
-}
-
-=item null
-
-Returns or sets the column null flag.
-
-=cut
-
-sub null {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $value =~ s/^NOT NULL$//i;
- $self->{'null'} = $value;
- } else {
- $self->{'null'};
- }
-}
-
-=item type
-
-Returns or sets the column length.
-
-=cut
-
-sub length {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{'length'} = $value;
- } else {
- $self->{'length'};
- }
-}
-
-=item line [ $datasrc ]
-
-Returns an SQL column definition.
-
-If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
-syntax. Non-standard syntax for other engines (if applicable) may also be
-supported in the future.
-
-=cut
-
-sub line {
- my($self,$datasrc)=@_;
- my($null)=$self->null;
- $null ||= "NOT NULL" if $datasrc =~ /mysql/; #yucky mysql hack
- join(' ',
- $self->name,
- $self->type. ( $self->length ? '('.$self->length.')' : '' ),
- $null,
- );
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::dbdef_table>, L<FS::dbdef>, L<DBI>
-
-=head1 HISTORY
-
-class for dealing with column definitions
-
-ivan@sisd.com 98-apr-17
-
-now methods can be used to get or set data ivan@sisd.com 98-may-11
-
-mySQL-specific hack for null (what should be default?) ivan@sisd.com 98-jun-2
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_index;
-
-use strict;
-use vars qw(@ISA);
-use FS::dbdef_colgroup;
-
-@ISA=qw(FS::dbdef_colgroup);
-
-=head1 NAME
-
-FS::dbdef_unique.pm - Index object
-
-=head1 SYNOPSIS
-
- use FS::dbdef_index;
-
- # see FS::dbdef_colgroup methods
-
-=head1 DESCRIPTION
-
-FS::dbdef_unique objects represent the (non-unique) indices of a table
-(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
-
-=head1 BUGS
-
-Is this empty subclass needed?
-
-=head1 SEE ALSO
-
-L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record>
-
-=head1 HISTORY
-
-class for dealing with index definitions
-
-ivan@sisd.com 98-apr-19
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_table;
-
-use strict;
-#use Carp;
-use Exporter;
-use vars qw(@ISA);
-use FS::dbdef_column;
-
-@ISA = qw(Exporter);
-
-=head1 NAME
-
-FS::dbdef_table - Table objects
-
-=head1 SYNOPSIS
-
- use FS::dbdef_table;
-
- $dbdef_table = new FS::dbdef_table (
- "table_name",
- "primary_key",
- $FS_dbdef_unique_object,
- $FS_dbdef_index_object,
- @FS_dbdef_column_objects,
- );
-
- $dbdef_table->addcolumn ( $FS_dbdef_column_object );
-
- $table_name = $dbdef_table->name;
- $dbdef_table->name ("table_name");
-
- $table_name = $dbdef_table->primary_keye;
- $dbdef_table->primary_key ("primary_key");
-
- $FS_dbdef_unique_object = $dbdef_table->unique;
- $dbdef_table->unique ( $FS_dbdef_unique_object );
-
- $FS_dbdef_index_object = $dbdef_table->index;
- $dbdef_table->index ( $FS_dbdef_index_object );
-
- @column_names = $dbdef->columns;
-
- $FS_dbdef_column_object = $dbdef->column;
-
- @sql_statements = $dbdef->sql_create_table;
- @sql_statements = $dbdef->sql_create_table $datasrc;
-
-=head1 DESCRIPTION
-
-FS::dbdef_table objects represent a single database table.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Creates a new FS::dbdef_table object.
-
-=cut
-
-sub new {
- my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
-
- my(%columns) = map { $_->name, $_ } @columns;
-
- #check $primary_key, $unique and $index to make sure they are $columns ?
- # (and sanity check?)
-
- my $class = ref($proto) || $proto;
- my $self = {
- 'name' => $name,
- 'primary_key' => $primary_key,
- 'unique' => $unique,
- 'index' => $index,
- 'columns' => \%columns,
- };
-
- bless ($self, $class);
-
-}
-
-=item addcolumn
-
-Adds this FS::dbdef_column object.
-
-=cut
-
-sub addcolumn {
- my($self,$column)=@_;
- ${$self->{'columns'}}{$column->name}=$column; #sanity check?
-}
-
-=item name
-
-Returns or sets the table name.
-
-=cut
-
-sub name {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{name} = $value;
- } else {
- $self->{name};
- }
-}
-
-=item primary_key
-
-Returns or sets the primary key.
-
-=cut
-
-sub primary_key {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{primary_key} = $value;
- } else {
- #$self->{primary_key};
- #hmm. maybe should untaint the entire structure when it comes off disk
- # cause if you don't trust that, ?
- $self->{primary_key} =~ /^(\w*)$/
- #aah!
- or die "Illegal primary key ", $self->{primary_key}, " in dbdef!\n";
- $1;
- }
-}
-
-=item unique
-
-Returns or sets the FS::dbdef_unique object.
-
-=cut
-
-sub unique {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{unique} = $value;
- } else {
- $self->{unique};
- }
-}
-
-=item index
-
-Returns or sets the FS::dbdef_index object.
-
-=cut
-
-sub index {
- my($self,$value)=@_;
- if ( defined($value) ) {
- $self->{'index'} = $value;
- } else {
- $self->{'index'};
- }
-}
-
-=item columns
-
-Returns a list consisting of the names of all columns.
-
-=cut
-
-sub columns {
- my($self)=@_;
- keys %{$self->{'columns'}};
-}
-
-=item column "column"
-
-Returns the column object (see L<FS::dbdef_column>) for "column".
-
-=cut
-
-sub column {
- my($self,$column)=@_;
- $self->{'columns'}->{$column};
-}
-
-=item sql_create_table [ $datasrc ]
-
-Returns an array of SQL statments to create this table.
-
-If passed a DBI $datasrc specifying L<DBD::mysql>, will use MySQL-specific
-syntax. Non-standard syntax for other engines (if applicable) may also be
-supported in the future.
-
-=cut
-
-sub sql_create_table {
- my($self,$datasrc)=@_;
-
- my(@columns)=map { $self->column($_)->line($datasrc) } $self->columns;
- push @columns, "PRIMARY KEY (". $self->primary_key. ")"
- if $self->primary_key;
- if ( $datasrc =~ /mysql/ ) { #yucky mysql hack
- push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
- push @columns, map "INDEX ($_)", $self->index->sql_list;
- }
-
- "CREATE TABLE ". $self->name. " ( ". join(", ", @columns). " )",
- ( map {
- my($index) = $_ . "_index";
- $index =~ s/,\s*/_/g;
- "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)"
- } $self->unique->sql_list ),
- ( map {
- my($index) = $_ . "_index";
- $index =~ s/,\s*/_/g;
- "CREATE INDEX $index ON ". $self->name. " ($_)"
- } $self->index->sql_list ),
- ;
-
-
-}
-
-=back
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<FS::dbdef>, L<FS::dbdef_unique>, L<FS::dbdef_index>, L<FS::dbdef_unique>,
-L<DBI>
-
-=head1 HISTORY
-
-class for dealing with table definitions
-
-ivan@sisd.com 98-apr-18
-
-gained extra functions (should %columns be an IxHash?)
-ivan@sisd.com 98-may-11
-
-sql_create_table returns a list of statments, not just one, and now it
-does indices (plus mysql hack) ivan@sisd.com 98-jun-2
-
-untaint primary_key... hmm. is this a hack around a bigger problem?
-looks like, did the same thing singles in colgroup!
-ivan@sisd.com 98-jun-4
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::dbdef_unique;
-
-use strict;
-use vars qw(@ISA);
-use FS::dbdef_colgroup;
-
-@ISA=qw(FS::dbdef_colgroup);
-
-=head1 NAME
-
-FS::dbdef_unique.pm - Unique object
-
-=head1 SYNOPSIS
-
- use FS::dbdef_unique;
-
- # see FS::dbdef_colgroup methods
-
-=head1 DESCRIPTION
-
-FS::dbdef_unique objects represent the unique indices of a database table
-(L<FS::dbdef_table>). FS::dbdef_unique inherits from FS::dbdef_colgroup.
-
-=head1 BUGS
-
-Is this empty subclass needed?
-
-=head1 SEE ALSO
-
-L<FS::dbdef_colgroup>, L<FS::dbdef_record>, L<FS::Record>
-
-=head1 HISTORY
-
-class for dealing with unique definitions
-
-ivan@sisd.com 98-apr-19
-
-pod ivan@sisd.com 98-sep-24
-
-=cut
-
-1;
-
-
+++ /dev/null
-package FS::part_pkg;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields fields);
-
-=head1 NAME
-
-FS::part_pkg - Object methods for part_pkg objects
-
-=head1 SYNOPSIS
-
- use FS::part_pkg;
-
- $record = create FS::part_pkg \%hash
- $record = create FS::part_pkg { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_pkg represents a billing item definition. FS::part_pkg inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgpart - primary key (assigned automatically for new billing item definitions)
-
-=item pkg - Text name of this billing item definition (customer-viewable)
-
-=item comment - Text name of this billing item definition (non-customer-viewable)
-
-=item setup - Setup fee
-
-=item freq - Frequency of recurring fee
-
-=item recur - Recurring fee
-
-=back
-
-setup and recur are evaluated as Safe perl expressions. You can use numbers
-just as you would normally. More advanced semantics are not yet defined.
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new billing item definition. To add the billing item definition to
-the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_pkg',$hashref);
-}
-
-=item insert
-
-Adds this billing item definition to the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete package definitions.";
-# maybe check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a part_pkg record!" unless $old->table eq "part_pkg";
- return "Can't change pkgpart!"
- unless $old->getfield('pkgpart') eq $new->getfield('pkgpart');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid billing item definition. If
-there is an error, returns the error, otherwise returns false. Called by the
-insert and replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a part_pkg record!" unless $self->table eq "part_pkg";
-
- $self->ut_numbern('pkgpart')
- or $self->ut_text('pkg')
- or $self->ut_text('comment')
- or $self->ut_anything('setup')
- or $self->ut_number('freq')
- or $self->ut_anything('recur')
- ;
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The delete method is unimplemented.
-
-setup and recur semantics are not yet defined (and are implemented in
-FS::cust_bill. hmm.).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
-schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 97-dec-5
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::part_referral;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::part_referral - Object methods for part_referral objects
-
-=head1 SYNOPSIS
-
- use FS::part_referral;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_referral represents a referral - where a customer heard of your
-services. This can be used to track the effectiveness of a particular piece of
-advertising, for example. FS::part_referral inherits from FS::Record. The
-following fields are currently supported:
-
-=over 4
-
-=item refnum - primary key (assigned automatically for new referrals)
-
-=item referral - Text name of this referral
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new referral. To add the referral to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_referral')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_referral',$hashref);
-}
-
-=item insert
-
-Adds this referral to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't (yet?) delete part_referral records";
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an part_referral record!"
- unless $old->table eq "part_referral";
- return "Can't change refnum!"
- unless $old->getfield('refnum') eq $new->getfield('refnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid referral. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a part_referral record!" unless $self->table eq "part_referral";
-
- my($error)=
- $self->ut_numbern('refnum')
- or $self->ut_text('referral')
- ;
- return $error if $error;
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The delete method is unimplemented.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::cust_main>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-Class dealing with referrals
-
-ivan@sisd.com 98-feb-23
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::part_svc;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields fields);
-
-=head1 NAME
-
-FS::part_svc - Object methods for part_svc objects
-
-=head1 SYNOPSIS
-
- use FS::part_svc;
-
- $record = create FS::part_referral \%hash
- $record = create FS::part_referral { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::part_svc represents a service definition. FS::part_svc inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcpart - primary key (assigned automatically for new service definitions)
-
-=item svc - text name of this service definition
-
-=item svcdb - table used for this service. See L<FS::svc_acct>,
-L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others.
-
-=item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
-
-=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new service definition. To add the service definition to the
-database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_svc',$hashref);
-}
-
-=item insert
-
-Adds this service definition to the database. If there is an error, returns
-the error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- return "Can't (yet?) delete service definitions.";
-# maybe check & make sure the svcpart isn't in cust_svc or (in any packages)?
-# my($self)=@_;
-#
-# $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a part_svc record!" unless $old->table eq "part_svc";
- return "Can't change svcpart!"
- unless $old->getfield('svcpart') eq $new->getfield('svcpart');
- return "Can't change svcdb!"
- unless $old->getfield('svcdb') eq $new->getfield('svcdb');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service definition. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a part_svc record!" unless $self->table eq "part_svc";
- my($recref) = $self->hashref;
-
- my($error);
- return $error if $error=
- $self->ut_numbern('svcpart')
- || $self->ut_text('svc')
- || $self->ut_alpha('svcdb')
- ;
-
- my(@fields) = eval { fields($recref->{svcdb}) }; #might die
- return "Unknown svcdb!" unless @fields;
-
- my($svcdb);
- foreach $svcdb ( qw(
- svc_acct svc_acct_sm svc_charge svc_domain svc_wo
- ) ) {
- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
- grep ! /_flag$/,
- grep /^${svcdb}__/,
- fields('part_svc');
- my($row);
- foreach $row (@rows) {
- unless ( $svcdb eq $recref->{svcdb} ) {
- $recref->{$svcdb.'__'.$row}='';
- $recref->{$svcdb.'__'.$row.'_flag'}='';
- next;
- }
- $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/
- or return "Illegal flag for $svcdb $row";
- $recref->{$svcdb.'__'.$row.'_flag'} = $1;
-
-# $recref->{$svcdb.'__'.$row} =~ /^(.*)$/ #not restrictive enough?
-# or return "Illegal value for $svcdb $row";
-# $recref->{$svcdb.'__'.$row} = $1;
- my($error);
- return $error if $error=$self->ut_anything($svcdb.'__'.$row);
-
- }
- }
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-Delete is unimplemented.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
-L<FS::svc_acct>, L<FS::svc_acct_sm>, L<FS::svc_domain>, schema.html from the
-base documentation.
-
-=head1 HISTORY
-
-ivan@sisd.com 97-nov-14
-
-data checking/untainting calls into FS::Record added
-ivan@sisd.com 97-dec-6
-
-pod ivan@sisd.com 98-sep-21
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::pkg_svc;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields hfields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(hfields);
-
-=head1 NAME
-
-FS::pkg_svc - Object methods for pkg_svc records
-
-=head1 SYNOPSIS
-
- use FS::pkg_svc;
-
- $record = create FS::pkg_svc \%hash;
- $record = create FS::pkg_svc { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::pkg_svc record links a billing item definition (see L<FS::part_pkg>) to
-a service definition (see L<FS::part_svc>). FS::pkg_svc inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
-
-=item svcpart - Service definition (see L<FS::part_svc>)
-
-=item quantity - Quantity of this service definition that this billing item
-definition includes
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('pkg_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('pkg_svc',$hashref);
-
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a pkg_svc record!" unless $old->table eq "pkg_svc";
- return "Can't change pkgpart!"
- if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change svcpart!"
- if $old->getfield('svcpart') ne $new->getfield('svcpart');
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a pkg_svc record!" unless $self->table eq "pkg_svc";
- my($recref) = $self->hashref;
-
- my($error);
- return $error if $error =
- $self->ut_number('pkgpart')
- || $self->ut_number('svcpart')
- || $self->ut_number('quantity')
- ;
-
- return "Unknown pkgpart!"
- unless qsearchs('part_pkg',{'pkgpart'=> $self->getfield('pkgpart')});
-
- return "Unknown svcpart!"
- unless qsearchs('part_svc',{'svcpart'=> $self->getfield('svcpart')});
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::part_pkg>, L<FS::part_svc>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-1
-
-added hfields
-ivan@sisd.com 97-nov-13
-
-pod ivan@sisd.com 98-sep-22
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_acct;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $dir_prefix @shells
- $shellmachine @saltset @pw_set);
-use Exporter;
-use FS::Conf;
-use FS::Record qw(fields qsearchs);
-use FS::SSH qw(ssh);
-use FS::cust_svc;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-$dir_prefix = $conf->config('home');
-@shells = $conf->config('shells');
-$shellmachine = $conf->config('shellmachine');
-
-@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
-
-#not needed in 5.004 #srand($$|time);
-
-=head1 NAME
-
-FS::svc_acct - Object methods for svc_acct records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct;
-
- $record = create FS::svc_acct \%hash;
- $record = create FS::svc_acct { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an account. FS::svc_acct inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatcially for new accounts)
-
-=item username
-
-=item _password - generated if blank
-
-=item popnum - Point of presence (see L<FS::svc_acct_pop>)
-
-=item uid
-
-=item gid
-
-=item finger - GECOS
-
-=item dir - set automatically if blank (and uid is not)
-
-=item shell
-
-=item quota - (unimplementd)
-
-=item slipip - IP address
-
-=item radius_I<Radius_Attribute> - I<Radius-Attribute>
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new account. To add the account to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct',$hashref);
-
-}
-
-=item insert
-
-Adds this account to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-If the configuration value (see L<FS::Conf>) shellmachine exists, and the
-username, uid, and dir fields are defined, the command
-
- useradd -d $dir -m -s $shell -u $uid $username
-
-is executed on shellmachine via ssh. This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
-
-=cut
-
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- return "Username ". $self->username. " in use"
- if qsearchs('svc_acct',{'username'=> $self->username } );
-
- my($part_svc) = qsearchs('part_svc',{ 'svcpart' => $self->svcpart });
- return "Unkonwn svcpart" unless $part_svc;
- return "uid in use"
- if $part_svc->svc_acct__uid_flag ne 'F'
- && qsearchs('svc_acct',{'uid'=> $self->uid } )
- && $self->username !~ /^(hyla)?fax$/
- ;
-
- my($svcnum)=$self->svcnum;
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->pkgnum,
- 'svcpart' => $self->svcpart,
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->svcnum($cust_svc->svcnum);
- }
-
- $error = $self->add;
- if ($error) {
- #$cust_svc->del if $cust_svc;
- $cust_svc->delete if $cust_svc;
- return $error;
- }
-
- my($username,$uid,$dir,$shell) = (
- $self->username,
- $self->uid,
- $self->dir,
- $self->shell,
- );
- if ( $username
- && $uid
- && $dir
- && $shellmachine
- && ! $nossh_hack ) {
- #one way
- ssh("root\@$shellmachine",
- "useradd -d $dir -m -s $shell -u $uid $username"
- );
- #another way
- #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ".
- # "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ".
- # "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ".
- # "/bin/chown -R $uid $dir") unless $nossh_hack;
- }
-
- ''; #no error
-}
-
-=item delete
-
-Deletes this account from the database. If there is an error, returns the
-error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-If the configuration value (see L<FS::Conf>) shellmachine exists, the command:
-
- userdel $username
-
-is executed on shellmachine via ssh. This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
-
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- my($username) = $self->getfield('username');
- if ( $username && $shellmachine && ! $nossh_hack ) {
- ssh("root\@$shellmachine","userdel $username");
- }
-
- '';
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-If the configuration value (see L<FS::Conf>) shellmachine exists, and the
-dir field has changed, the command:
-
- [ -d $old_dir ] && (
- chmod u+t $old_dir;
- umask 022;
- mkdir $new_dir;
- cd $old_dir;
- find . -depth -print | cpio -pdm $new_dir;
- chmod u-t $new_dir;
- chown -R $uid.$gid $new_dir;
- rm -rf $old_dir
- )
-
-is executed on shellmachine via ssh. This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct record!" unless $old->table eq "svc_acct";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- return "Username in use"
- if $old->getfield('username') ne $new->getfield('username') &&
- qsearchs('svc_acct',{'username'=> $new->getfield('username') } );
-
- return "Can't change uid!"
- if $old->getfield('uid') ne $new->getfield('uid');
-
- #change homdir when we change username
- if ( $old->getfield('username') ne $new->getfield('username') ) {
- $new->setfield('dir','');
- }
-
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- my($old_dir,$new_dir)=( $old->getfield('dir'),$new->getfield('dir') );
- my($uid,$gid)=( $new->getfield('uid'), $new->getfield('gid') );
- if ( $old_dir
- && $new_dir
- && $old_dir ne $new_dir
- && ! $nossh_hack
- ) {
- ssh("root\@$shellmachine","[ -d $old_dir ] && ".
- "( chmod u+t $old_dir; ". #turn off qmail delivery
- "umask 022; mkdir $new_dir; cd $old_dir; ".
- "find . -depth -print | cpio -pdm $new_dir; ".
- "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ".
- "rm -rf $old_dir".
- ")"
- );
- }
-
- ''; #no error
-}
-
-=item suspend
-
-Suspends this account by prefixing *SUSPENDED* to the password. If there is an
-error, returns the error, otherwise returns false.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- my($old) = @_;
- my(%hash) = $old->hash;
- unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
- $hash{_password} = '*SUSPENDED* '.$hash{_password};
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
- } else {
- ''; #no error (already suspended)
- }
-
-}
-
-=item unsuspend
-
-Unsuspends this account by removing *SUSPENDED* from the password. If there is
-an error, returns the error, otherwise returns false.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- my($old) = @_;
- my(%hash) = $old->hash;
- if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
- $hash{_password} = $1;
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
- } else {
- ''; #no error (already unsuspended)
- }
-}
-
-=item cancel
-
-Just returns false (no error) for now.
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-# Usage: $error = $record -> cancel;
-sub cancel {
- ''; #stub (no error) - taken care of in delete
-}
-
-=item check
-
-Checks all fields to make sure this is a valid service. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_acct record!" unless $self->table eq "svc_acct";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
- }
- }
-
- my($ulen)=$self->dbdef_table->column('username')->length;
- $recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/
- or return "Illegal username";
- $recref->{username} = $1;
- $recref->{username} =~ /[a-z]/ or return "Illegal username";
-
- $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum";
- $recref->{popnum} = $1;
- return "Unkonwn popnum" unless
- ! $recref->{popnum} ||
- qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
-
- unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
-
- $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
- $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
-
- $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
- $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
- #not all systems use gid=uid
- #you can set a fixed gid in part_svc
-
- return "Only root can have uid 0"
- if $recref->{uid} == 0 && $recref->{username} ne 'root';
-
- my($error);
- return $error if $error=$self->ut_textn('finger');
-
- $recref->{dir} =~ /^([\/\w\-]*)$/
- or return "Illegal directory";
- $recref->{dir} = $1 ||
- $dir_prefix . '/' . $recref->{username}
- #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
- ;
-
- unless ( $recref->{username} eq 'sync' ) {
- my($shell);
- if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) {
- $recref->{shell} = $shell;
- } else {
- return "Illegal shell ". $self->shell;
- }
- } else {
- $recref->{shell} = '/bin/sync';
- }
-
- $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
- $recref->{quota} = $1;
-
- } else {
- $recref->{gid} ne '' ?
- return "Can't have gid without uid" : ( $recref->{gid}='' );
- $recref->{finger} ne '' ?
- return "Can't have finger-name without uid" : ( $recref->{finger}='' );
- $recref->{dir} ne '' ?
- return "Can't have directory without uid" : ( $recref->{dir}='' );
- $recref->{shell} ne '' ?
- return "Can't have shell without uid" : ( $recref->{shell}='' );
- $recref->{quota} ne '' ?
- return "Can't have quota without uid" : ( $recref->{quota}='' );
- }
-
- unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
- unless ( $recref->{slipip} eq '0e0' ) {
- $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
- or return "Illegal slipip". $self->slipip;
- $recref->{slipip} = $1;
- } else {
- $recref->{slipip} = '0e0';
- }
-
- }
-
- #arbitrary RADIUS stuff; allow ut_textn for now
- foreach ( grep /^radius_/, fields('svc_acct') ) {
- $self->ut_textn($_);
- }
-
- #generate a password if it is blank
- $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
- unless ( $recref->{_password} );
-
- #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
- if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,8})$/ ) {
- $recref->{_password} = $1.$3;
- #uncomment this to encrypt password immediately upon entry, or run
- #bin/crypt_pw in cron to give new users a window during which their
- #password is available to techs, for faxing, etc. (also be aware of
- #radius issues!)
- #$recref->{password} = $1.
- # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
- #;
- } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/]{13,24})$/ ) {
- $recref->{_password} = $1.$3;
- } elsif ( $recref->{_password} eq '*' ) {
- $recref->{_password} = '*';
- } else {
- return "Illegal password";
- }
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The remote commands should be configurable.
-
-The create method should set defaults from part_svc (like the check method
-sets fixed values).
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>, schema.html from the base
-documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-16 - 21
-
-rewrite (among other things, now know about part_svc) ivan@sisd.com 98-mar-8
-
-Changed 'password' to '_password' because Pg6.3 reserves the password word
- bmccane@maxbaud.net 98-apr-3
-
-username length and shell no longer hardcoded ivan@sisd.com 98-jun-28
-
-eww but needed: ignore uid duplicates for 'fax' and 'hylafax'
-ivan@sisd.com 98-jun-29
-
-$nossh_hack ivan@sisd.com 98-jul-13
-
-protections against UID/GID of 0 for incorrectly-setup RDBMSs (also
-in bin/svc_acct.export) ivan@sisd.com 98-jul-13
-
-arbitrary radius attributes ivan@sisd.com 98-aug-13
-
-/var/spool/freeside/conf/shellmachine ivan@sisd.com 98-aug-13
-
-pod and FS::conf ivan@sisd.com 98-sep-22
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_acct_pop;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::svc_acct_pop - Object methods for svc_acct_pop records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct_pop;
-
- $record = create FS::svc_acct_pop \%hash;
- $record = create FS::svc_acct_pop { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents an point of presence. FS::svc_acct_pop
-inherits from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item popnum - primary key (assigned automatically for new accounts)
-
-=item city
-
-=item state
-
-=item ac - area code
-
-=item exch - exchange
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new point of presence (if only it were that easy!). To add the
-point of presence to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_pop')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_pop',$hashref);
-}
-
-=item insert
-
-Adds this point of presence to the databaes. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't (yet) delete POPs!";
- #$self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an svc_acct_pop record!"
- unless $old->table eq "svc_acct_pop";
- return "Can't change popnum!"
- unless $old->getfield('popnum') eq $new->getfield('popnum');
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid point of presence. If there is
-an error, returns the error, otherwise returns false. Called by the insert
-and replace methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_acct_pop record!" unless $self->table eq "svc_acct_pop";
-
- my($error)=
- $self->ut_numbern('popnum')
- or $self->ut_text('city')
- or $self->ut_text('state')
- or $self->ut_number('ac')
- or $self->ut_number('exch')
- ;
- return $error if $error;
-
- '';
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-It should be renamed to part_pop.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<svc_acct>, schema.html from the base documentation.
-
-=head1 HISTORY
-
-Class dealing with pops
-
-ivan@sisd.com 98-mar-8
-
-pod ivan@sisd.com 98-sep-23
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_acct_sm;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $shellmachine @qmailmachines);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
-use FS::SSH qw(ssh);
-use FS::Conf;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-
-$shellmachine = $conf->exists('qmailmachines')
- ? $conf->config('shellmachine')
- : '';
-
-=head1 NAME
-
-FS::svc_acct_sm - Object methods for svc_acct_sm records
-
-=head1 SYNOPSIS
-
- use FS::svc_acct_sm;
-
- $record = create FS::svc_acct_sm \%hash;
- $record = create FS::svc_acct_sm { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_acct object represents a virtual mail alias. FS::svc_acct inherits
-from FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatcially for new accounts)
-
-=item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>)
-
-=item domuid - uid of the target account (see L<FS::svc_acct>)
-
-=item domuser - virtual username
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new virtual mail alias. To add the virtual mail alias to the
-database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_sm')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_sm',$hashref);
-
-}
-
-=item insert
-
-Adds this virtual mail alias to the database. If there is an error, returns
-the error, otherwise returns false.
-
-The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines
-exist, and domuser is `*' (meaning a catch-all mailbox), the command:
-
- [ -e $dir/.qmail-$qdomain-default ] || {
- touch $dir/.qmail-$qdomain-default;
- chown $uid:$gid $dir/.qmail-$qdomain-default;
- }
-
-is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
-This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.
-
-=cut
-
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- return "Domain username (domuser) in use for this domain (domsvc)"
- if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser,
- 'domsvc' => $self->domsvc,
- } );
-
- return "First domain username (domuser) for domain (domsvc) must be " .
- qq='*' (catch-all)!=
- if $self->domuser ne '*' &&
- ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } );
-
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
-
- my $svc_domain = qsearchs('svc_domain',{'svcnum'=> $self->domsvc } );
- my $svc_acct = qsearchs('svc_acct',{'uid'=> $self->domuid } );
- my($uid,$gid,$dir,$domain)=(
- $svc_acct->getfield('uid'),
- $svc_acct->getfield('gid'),
- $svc_acct->getfield('dir'),
- $svc_domain->getfield('domain')
- );
- my($qdomain)=$domain;
- $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
- ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
- if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
-
- ''; #no error
-
-}
-
-=item delete
-
-Deletes this virtual mail alias from the database. If there is an error,
-returns the error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct_sm record!" unless $old->table eq "svc_acct_sm";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- return "Domain username (domuser) in use for this domain (domsvc)"
- if ( $old->domuser ne $new->domuser
- || $old->domsvc ne $new->domsvc
- ) && qsearchs('svc_acct_sm',{
- 'domuser'=> $new->domuser,
- 'domsvc' => $new->domsvc,
- } )
- ;
-
- $error=$new->check;
- return $error if $error;
-
- $error = $new->rep($old);
- return $error if $error;
-
- ''; #no error
-}
-
-=item suspend
-
-Just returns false (no error) for now.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
-=item unsuspend
-
-Just returns false (no error) for now.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
-=item cancel
-
-Just returns false (no error) for now.
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
-=item check
-
-Checks all fields to make sure this is a valid virtual mail alias. If there is
-an error, returns the error, otherwise returns false. Called by the insert and
-replace methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_acct_sm record!" unless $self->table eq "svc_acct_sm";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc
- my($svcpart);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- } else {
- $svcpart=$self->getfield('svcpart');
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct_sm') ) {
- if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
- }
- }
-
- $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
- or return "Illegal domain username (domuser)";
- $recref->{domuser} = $1;
-
- $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
- $recref->{domsvc} = $1;
- my($svc_domain);
- return "Unknown domsvc" unless
- $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
-
- $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
- $recref->{domuid} = $1;
- my($svc_acct);
- return "Unknown uid" unless
- $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
-
- ''; #no error
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-The remote commands should be configurable.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::svc_acct>, L<FS::svc_domain>, L<FS::SSH>, L<ssh>, L<dot-qmail>,
-schema.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-16 - 21
-
-rewrite ivan@sisd.com 98-mar-10
-
-s/qsearchs/qsearch/ to eliminate warning ivan@sisd.com 98-apr-19
-
-uses conf/shellmachine and has an nossh_hack ivan@sisd.com 98-jul-14
-
-s/\./:/g in .qmail-domain:com ivan@sisd.com 98-aug-13
-
-pod, FS::Conf, moved .qmail file from check to insert 98-sep-23
-
-=cut
-
-1;
-
+++ /dev/null
-package FS::svc_domain;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine);
-use Exporter;
-use Carp;
-use Mail::Internet;
-use Mail::Header;
-use Date::Format;
-use FS::Record qw(fields qsearch qsearchs);
-use FS::cust_svc;
-use FS::Conf;
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-$conf = new FS::Conf;
-
-$mydomain = $conf->config('domain');
-$smtpmachine = $conf->config('smtpmachine');
-
-my($internic)="/var/spool/freeside/conf/registries/internic";
-my($conf_tech)="$internic/tech_contact";
-my($conf_from)="$internic/from";
-my($conf_to)="$internic/to";
-my($nameservers)="$internic/nameservers";
-my($template)="$internic/template";
-
-open(TECH_CONTACT,$conf_tech) or die "Can't open $conf_tech: $!";
-my($tech_contact)=map {
- /^(.*)$/ or die "Illegal line in $conf_tech!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TECH_CONTACT>;
-close TECH_CONTACT;
-
-open(FROM,$conf_from) or die "Can't open $conf_from: $!";
-my($from)=map {
- /^(.*)$/ or die "Illegal line in $conf_from!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <FROM>;
-close FROM;
-
-open(TO,$conf_to) or die "Can't open $conf_to: $!";
-my($to)=map {
- /^(.*)$/ or die "Illegal line in $conf_to!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <TO>;
-close TO;
-
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameservers)=map {
- /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-open(NAMESERVERS,$nameservers) or die "Can't open $nameservers: $!";
-my(@nameserver_ips)=map {
- /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/
- or die "Illegal line in $nameservers!"; #yes, we trust the file
- $1;
-} grep $_ !~ /^(#|$)/, <NAMESERVERS>;
-close NAMESERVERS;
-
-open(TEMPLATE,$template) or die "Can't open $template: $!";
-my(@template)=map {
- /^(.*)$/ or die "Illegal line in $to!"; #yes, we trust the file
- $1. "\n";
-} <TEMPLATE>;
-close TEMPLATE;
-
-=head1 NAME
-
-FS::svc_domain - Object methods for svc_domain records
-
-=head1 SYNOPSIS
-
- use FS::svc_domain;
-
- $record = create FS::svc_domain \%hash;
- $record = create FS::svc_domain { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
- $error = $record->suspend;
-
- $error = $record->unsuspend;
-
- $error = $record->cancel;
-
-=head1 DESCRIPTION
-
-An FS::svc_domain object represents a domain. FS::svc_domain inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item svcnum - primary key (assigned automatically for new accounts)
-
-=item domain
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Creates a new domain. To add the domain to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_domain')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_domain',$hashref);
-
-}
-
-=item insert
-
-Adds this domain to the database. If there is an error, returns the error,
-otherwise returns false.
-
-The additional fields I<pkgnum> and I<svcpart> (see L<FS::cust_svc>) should be
-defined. An FS::cust_svc record will be created and inserted.
-
-The additional field I<action> should be set to I<N> for new domains or I<M>
-for transfers.
-
-A registration or transfer email will be submitted unless
-$FS::svc_domain::whois_hack is true.
-
-=cut
-
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- return "Domain in use (here)"
- if qsearchs('svc_domain',{'domain'=> $self->domain } );
-
- my($whois)=(($self->_whois)[0]);
- return "Domain in use (see whois)"
- if ( $self->action eq "N" && $whois !~ /^No match for/ );
- return "Domain not found (see whois)"
- if ( $self->action eq "M" && $whois =~ /^No match for/ );
-
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
- unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
- 'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
- } );
- my($error) = $cust_svc->insert;
- return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
- }
-
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
- return $error;
- }
-
- $self->submit_internic unless $whois_hack;
-
- ''; #no error
-}
-
-=item delete
-
-Deletes this domain from the database. If there is an error, returns the
-error, otherwise returns false.
-
-The corresponding FS::cust_svc record will be deleted as well.
-
-=cut
-
-sub delete {
- my($self)=@_;
- my($error);
-
- my($svcnum)=$self->getfield('svcnum');
-
- $error = $self->del;
- return $error if $error;
-
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
- return $error if $error;
-
- '';
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_domain record!" unless $old->table eq "svc_domain";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- return "Can't change domain - reorder."
- if $old->getfield('domain') ne $new->getfield('domain');
-
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- '';
-
-}
-
-=item suspend
-
-Just returns false (no error) for now.
-
-Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub suspend {
- ''; #no error (stub)
-}
-
-=item unsuspend
-
-Just returns false (no error) for now.
-
-Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub unsuspend {
- ''; #no error (stub)
-}
-
-=item cancel
-
-Just returns false (no error) for now.
-
-Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
-
-=cut
-
-sub cancel {
- ''; #no error (stub)
-}
-
-=item check
-
-Checks all fields to make sure this is a valid domain. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-Sets any fixed values; see L<FS::part_svc>.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a svc_domain record!" unless $self->table eq "svc_domain";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
-
- #get part_svc (and pkgnum)
- my($svcpart,$pkgnum);
- my($svcnum)=$self->getfield('svcnum');
- if ($svcnum) {
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- return "Unknown svcnum" unless $cust_svc;
- $svcpart=$cust_svc->svcpart;
- $pkgnum=$cust_svc->pkgnum;
- } else {
- $svcpart=$self->svcpart;
- $pkgnum=$self->pkgnum;
- }
- my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
- return "Unkonwn svcpart" unless $part_svc;
-
- #set fixed fields from part_svc
- my($field);
- foreach $field ( fields('svc_acct') ) {
- if ( $part_svc->getfield('svc_domain__'. $field. '_flag') eq 'F' ) {
- $self->setfield($field,$part_svc->getfield('svc_domain__'. $field) );
- }
- }
-
- unless ( $whois_hack ) {
- unless ( $self->email ) { #find out an email address
- my(@svc_acct);
- foreach ( qsearch('cust_svc',{'pkgnum'=>$pkgnum}) ) {
- my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$_->svcnum});
- push @svc_acct, $svc_acct if $svc_acct;
- }
-
- if ( scalar(@svc_acct) == 0 ) {
- return "Must order an account first";
- } elsif ( scalar(@svc_acct) > 1 ) {
- return "More than one account in package ". $pkgnum. ": specify admin contact email";
- } else {
- $self->email($svc_acct[0]->username. '@'. $mydomain);
- }
- }
- }
-
- #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) {
- if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) {
- $recref->{domain} = "$1.$2";
- # hmmmmmmmm.
- } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) {
- $recref->{domain} = $1;
- } else {
- return "Illegal domain ". $recref->{domain}.
- " (or unknown registry - try \$whois_hack)";
- }
-
- $recref->{action} =~ /^(M|N)$/ or return "Illegal action";
- $recref->{action} = $1;
-
- $self->ut_textn('purpose');
-
-}
-
-=item _whois
-
-Executes the command:
-
- whois do $domain
-
-and returns the output.
-
-(Always returns I<No match for domian "$domain".> if
-$FS::svc_domain::whois_hack is set true.)
-
-=cut
-
-sub _whois {
- my($self)=@_;
- my($domain)=$self->domain;
- return ( "No match for domain \"$domain\"." ) if $whois_hack;
- open(WHOIS,"whois do $domain |");
- return <WHOIS>;
-}
-
-=item submit_internic
-
-Submits a registration email for this domain.
-
-=cut
-
-sub submit_internic {
- my($self)=@_;
-
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$self->pkgnum});
- return unless $cust_pkg;
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
- return unless $cust_main;
-
- my(%subs)=(
- 'action' => $self->action,
- 'purpose' => $self->purpose,
- 'domain' => $self->domain,
- 'company' => $cust_main->company
- || $cust_main->getfield('first'). ' '.
- $cust_main->getfield('last')
- ,
- 'city' => $cust_main->city,
- 'state' => $cust_main->state,
- 'zip' => $cust_main->zip,
- 'country' => $cust_main->country,
- 'last' => $cust_main->getfield('last'),
- 'first' => $cust_main->getfield('first'),
- 'daytime' => $cust_main->daytime,
- 'fax' => $cust_main->fax,
- 'email' => $self->email,
- 'tech_contact' => $tech_contact,
- 'primary' => shift @nameservers,
- 'primary_ip' => shift @nameserver_ips,
- );
-
- #yuck
- my(@xtemplate)=@template;
- my(@body);
- my($line);
- OLOOP: while ( defined($line = shift @xtemplate) ) {
-
- if ( $line =~ /^###LOOP###$/ ) {
- my(@buffer);
- LOADBUF: while ( defined($line = shift @xtemplate) ) {
- last LOADBUF if ( $line =~ /^###ENDLOOP###$/ );
- push @buffer, $line;
- }
- my(%lubs)=(
- 'address' => $cust_main->address2
- ? [ $cust_main->address1, $cust_main->address2 ]
- : [ $cust_main->address1 ]
- ,
- 'secondary' => [ @nameservers ],
- 'secondary_ip' => [ @nameserver_ips ],
- );
- LOOP: while (1) {
- my(@xbuffer)=@buffer;
- SUBLOOP: while ( defined($line = shift @xbuffer) ) {
- if ( $line =~ /###(\w+)###/ ) {
- #last LOOP unless my($lub)=shift@{$lubs{$1}};
- next OLOOP unless my $lub = shift @{$lubs{$1}};
- $line =~ s/###(\w+)###/$lub/e;
- redo SUBLOOP;
- } else {
- push @body, $line;
- }
- } #SUBLOOP
- } #LOOP
-
- }
-
- if ( $line =~ /###(\w+)###/ ) {
- #$line =~ s/###(\w+)###/$subs{$1}/eg;
- $line =~ s/###(\w+)###/$subs{$1}/e;
- redo OLOOP;
- } else {
- push @body, $line;
- }
-
- } #OLOOP
-
- my($subject);
- if ( $self->action eq "M" ) {
- $subject = "MODIFY DOMAIN ". $self->domain;
- } elsif ($self->action eq "N" ) {
- $subject = "NEW DOMAIN ". $self->domain;
- } else {
- croak "submit_internic called with action ". $self->action;
- }
-
- $ENV{SMTPHOSTS}=$smtpmachine;
- $ENV{MAILADDRESS}=$from;
- my($header)=Mail::Header->new( [
- "From: $from",
- "To: $to",
- "Sender: $from",
- "Reply-To: $from",
- "Date: ". time2str("%a, %d %b %Y %X %z",time),
- "Subject: $subject",
- ] );
-
- my($msg)=Mail::Internet->new(
- 'Header' => $header,
- 'Body' => \@body,
- );
-
- $msg->smtpsend or die "Can't send registration email"; #die? warn?
-
-}
-
-=back
-
-=head1 BUGS
-
-It doesn't properly override FS::Record yet.
-
-All BIND/DNS fields should be included (and exported).
-
-All registries should be supported.
-
-Not all configuration access is through FS::Conf!
-
-Should change action to a real field.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
-L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation,
-config.html from the base documentation.
-
-=head1 HISTORY
-
-ivan@voicenet.com 97-jul-21
-
-rewrite ivan@sisd.com 98-mar-10
-
-add internic bits ivan@sisd.com 98-mar-14
-
-Changed 'day' to 'daytime' because Pg6.3 reserves the day word
- bmccane@maxbaud.net 98-apr-3
-
-/var/spool/freeside/conf/registries/internic/, Mail::Internet, etc.
-ivan@sisd.com 98-jul-17-19
-
-pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23
-
-=cut
-
-1;
-
-
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-21
-
-package FS::svc_table;
-
-use strict;
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@FS::svc_table::ISA = qw(FS::Record Exporter);
-
-# Usage: $record = create FS::svc_table ( \%hash );
-# $record = create FS::svc_table ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('svc_table')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('svc_table',$hashref);
-
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
- my($error);
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error=$self->check;
- return $error if $error;
-
- $error = $self->add;
- return $error if $error;
-
- ''; #no error
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
- my($error);
-
- $error = $self->del;
- return $error if $error;
-
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_table record!" unless $old->table eq "svc_table";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
-
- $error=$new->check;
- return $error if $error;
-
- $error = $new->rep($old);
- return $error if $error;
-
- ''; #no error
-}
-
-# Usage: $error = $record -> suspend;
-sub suspend {
- ''; #no error (stub)
-}
-
-# Usage: $error = $record -> unsuspend;
-sub unsuspend {
- ''; #no error (stub)
-}
-
-# Usage: $error = $record -> cancel;
-sub cancel {
- ''; #no error (stub)
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a svc_table record!" unless $self->table eq "svc_table";
- my($recref) = $self->hashref;
-
- $recref->{svcnum} =~ /^(\d+)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
- return "Unknown svcnum" unless
- qsearchs('cust_svc',{'svcnum'=> $recref->{svcnum} } );
-
- #DATA CHECKS GO HERE!
-
- ''; #no error
-}
-
-1;
-
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-1
-#
-# added hfields
-# ivan@sisd.com 97-nov-13
-
-package FS::table_name;
-
-use strict;
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearch qsearchs);
-
-@FS::table_name::ISA = qw(FS::Record Exporter);
-@FS::table_name::EXPORT_OK = qw(hfields);
-
-# Usage: $record = create FS::table_name ( \%hash );
-# $record = create FS::table_name ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('table_name')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('table_name',$hashref);
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
- return "Can't change keyfield!"
- unless $old->getfield('keyfield') eq $new->getfield('keyfield');
- $new->check or
- $new->rep($old);
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
- my($recref) = $self->hashref;
-
- ''; #no error
-}
-
-1;
-
+++ /dev/null
-#!/usr/local/bin/perl -Tw
-#
-# ivan@voicenet.com 97-jul-1
-#
-# added hfields
-# ivan@sisd.com 97-nov-13
-
-package FS::table_name;
-
-use strict;
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(hfields qsearch qsearchs);
-
-@FS::table_name::ISA = qw(FS::Record Exporter);
-@FS::table_name::EXPORT_OK = qw(hfields);
-
-# Usage: $record = create FS::table_name ( \%hash );
-# $record = create FS::table_name ( { field=>value, ... } );
-sub create {
- my($proto,$hashref)=@_;
-
- my($field);
- foreach $field (fields('table_name')) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
-
- $proto->new('table_name',$hashref);
-
-}
-
-# Usage: $error = $record -> insert;
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-# Usage: $error = $record -> delete;
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-# Usage: $error = $newrecord -> replace($oldrecord)
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
-
- $new->check or
- $new->rep($old);
-}
-
-# Usage: $error = $record -> check;
-sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
- my($recref) = $self->hashref;
-
- ''; #no error
-}
-
-1;
-
+++ /dev/null
-package FS::type_pkgs;
-
-use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearchs);
-
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
-
-=head1 NAME
-
-FS::type_pkgs - Object methods for type_pkgs records
-
-=head1 SYNOPSIS
-
- use FS::type_pkgs;
-
- $record = create FS::type_pkgs \%hash;
- $record = create FS::type_pkgs { 'column' => 'value' };
-
- $error = $record->insert;
-
- $error = $new_record->replace($old_record);
-
- $error = $record->delete;
-
- $error = $record->check;
-
-=head1 DESCRIPTION
-
-An FS::type_pkgs record links an agent type (see L<FS::agent_type>) to a
-billing item definition (see L<FS::part_pkg>). FS::type_pkgs inherits from
-FS::Record. The following fields are currently supported:
-
-=over 4
-
-=item typenum - Agent type, see L<FS::agent_type>
-
-=item pkgpart - Billing item definition, see L<FS::part_pkg>
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item create HASHREF
-
-Create a new record. To add the record to the database, see L<"insert">.
-
-=cut
-
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('type_pkgs')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('type_pkgs',$hashref);
-
-}
-
-=item insert
-
-Adds this record to the database. If there is an error, returns the error,
-otherwise returns false.
-
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
-=item delete
-
-Deletes this record from the database. If there is an error, returns the
-error, otherwise returns false.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
-=item replace OLD_RECORD
-
-Replaces OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
-
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a type_pkgs record!" unless $old->table eq "type_pkgs";
-
- $new->check or
- $new->rep($old);
-}
-
-=item check
-
-Checks all fields to make sure this is a valid record. If there is an error,
-returns the error, otherwise returns false. Called by the insert and replace
-methods.
-
-=cut
-
-sub check {
- my($self)=@_;
- return "Not a type_pkgs record!" unless $self->table eq "type_pkgs";
- my($recref) = $self->hashref;
-
- $recref->{typenum} =~ /^(\d+)$/ or return "Illegal typenum";
- $recref->{typenum} = $1;
- return "Unknown typenum"
- unless qsearchs('agent_type',{'typenum'=>$recref->{typenum}});
-
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart} = $1;
- return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
-
- ''; #no error
-}
-
-=back
-
-=head1 HISTORY
-
-Defines the relation between agent types and pkgparts
-(Which pkgparts can the different [types of] agents sell?)
-
-ivan@sisd.com 97-nov-13
-
-change to ut_ FS::Record, fixed bugs
-ivan@sisd.com 97-dec-10
-
-=cut
-
-1;
-
projects / freeside.git / commitdiff
