From: cvs2git Date: Mon, 23 Apr 2001 13:09:05 +0000 (+0000) Subject: This commit was manufactured by cvs2svn to create tag 'freeside_1_3_0'. X-Git-Tag: freeside_1_3_0 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=069f8453eb624a0d4a77734aca8bc9367dbb60e6;hp=80ba0c074354875c288c143721af08a0a5d02e42 This commit was manufactured by cvs2svn to create tag 'freeside_1_3_0'. --- diff --git a/CREDITS b/CREDITS index 87c79a779..cf98b61d2 100644 --- a/CREDITS +++ b/CREDITS @@ -1,14 +1,82 @@ Thanks to Matt Simerson 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 did the default background image and is also -# the creator of Freeside's mascot, Snakeman. +Steve Cleff 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 did the "SISD" graphic. +Jerry St. Pierre did the "SISD" graphic used in +1.0.x and most of 1.1.x. + +Mark Norris of Urban Design, Inc. did the red "S" +logo for later 1.1.x versions and 1.2.x Brian McCane? contributed PostgreSQL support, HTML style enhancements and many, many bugfixes. -Everything else is my (Ivan Kohler ) fault. +Cerkit 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 and Roger Mangraviti + contributed state/provence listings for Australia. + +Peter Wemm sent in a bunch of bugfixes for the 1.2 +release. + +Greg Kuhnert sent some documentation updates. + +Joel Griffiths contribued many bugfixes as well as +the print-batch script. + +NetLoud funded the development of the following +features: + - IEAK support for the signup server + - Pre-payment support + +NetAcces.Net (not netaccess.net) funded the development of the following +features: + - DNS tracking and export to BIND configuration files + - Web site virtual host tracking and export to Apache configuration files + +Kristian Hoffmann contributed Netscape CCK +autoconfiguration support for the signup server, lots of great mailing +lists posts which I shamelessly made into documentation, fixes to get rid of +the embarassing and non-database-normal "owed" field, and many other things +I'm forgetting. + +Jeff Finucane send in a bunch of bugfixes (for the sendmail +export, cancel-unaudited.cgi), patches to support billing date modification, +and probably other things too (sorry if I forgot them). And yet even more +bug squashing, thanks! + +Kenny Elliott contributed ICRADIUS radreply table support, +allowing attributes with ICRADIUS, helped fix many bugs, and some +other stuff I can't recall (sorry). + +Stephen Amadei contribued portability cleanups for the +low-level DBI stuff. + +Jason Spence contributed admin.html and other +documentation, autocapnames javascript, bugfixes & other neat stuff I can't +remember. + +Brad Dameron contributed code to do configurable state +and referral defaults. + +Surf and Sip, Inc., generously sponsored a +long-requested feature - the session monitor and time-based prepaid cards. +Matt Peterson and Mack ? tested +the new features and contributed many bugfixes. + +Everything else is my (Ivan Kohler ) fault. diff --git a/FS/Changes b/FS/Changes new file mode 100644 index 000000000..c94ef10f5 --- /dev/null +++ b/FS/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension FS. + +0.01 Wed Aug 4 00:13:45 1999 + - original version; created by h2xs 1.19 + diff --git a/FS/FS.pm b/FS/FS.pm new file mode 100644 index 000000000..ed61db4c8 --- /dev/null +++ b/FS/FS.pm @@ -0,0 +1,157 @@ +package FS; + +use strict; +use vars qw($VERSION); + +$VERSION = '0.01'; + +1; +__END__ + +=head1 NAME + +FS - Freeside Perl modules + +=head1 SYNOPSIS + +FS is the unofficial (i.e. non-CPAN) prefix for the Perl module portion of the +Freeside ISP billing software. This includes: + +=head2 Utility classes + +L - Freeside configuration values + +L - User class (not yet OO) + +L - 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 - Database record base class + +L - POP (Point of Presence, not Post +Office Protocol) class + +L - Referral class + +L - Locale (tax rate) class + +L - Service base class + +L - Account (shell, RADIUS, POP3) class + +L - Domain class + +L - DNS zone entries + +L - Vitual mail alias class + +L - Web virtual host class. + +L - Service definition class + +L - Package (billing item) definition class + +L - Class linking package (billing item) +definitions (see L) with service definitions +(see L) + +L - Agent (reseller) class + +L - Agent type class + +L - Class linking agent types (see +L) with package (billing item) definitions +(see L) + +L - Service class + +L - Package (billing item) class + +L - Customer class + +L - Invoice destination +class + +L - Invoice class + +L - Invoice line item class + +L - Payment class + +L - Credit class + +L - Refund class + +L - Credit card transaction queue class + +L - Prepaid "calling card" credit class. + +L - Network Access Server class + +L - NAS port class + +L - User login session class + +=head2 User Interface classes (under development; not yet usable) + +L - User-interface base class + +L - Gtk user-interface class + +L - CGI (HTML) user-interface class + +L - 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 . + +The main documentation is in htdocs/docs. + +=head1 VERSION + +$Id: FS.pm,v 1.5 2001-04-23 12:40:30 ivan Exp $ + +=head1 SUPPORT + +A mailing list for users and developers is available. Send a blank message to + to subscribe. + +Commercial support is available; see +. + +=head1 AUTHOR + +Primarily Ivan Kohler , with help from many kind folks. + +See the CREDITS file in the Freeside distribution for a (hopefully) complete +list and the individal files for details. + +=head1 SEE ALSO + +perl(1), main Freeside documentation in htdocs/docs/ + +=head1 BUGS + +The version number of the FS Perl extension differs from the version of the +Freeside distribution, which are both different from the CVS version tag for +each file, which appears under the VERSION heading. + +Those modules which would be useful separately should be pulled out, +renamed appropriately and uploaded to CPAN. So far: DBIx::DBSchema, Net::SSH +and Net::SCP... + +=cut + diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm new file mode 100644 index 000000000..198477ce6 --- /dev/null +++ b/FS/FS/CGI.pm @@ -0,0 +1,218 @@ +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 = < + + + $title + + + + + $title + +

+END + $x .= $menubar. "

" 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!$item!; + } + 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 < + + Error processing your request + + +
+

Error processing your request

+
+ Your request could not be processed because of the following error: +

$error + + +END + +} + +=item eidiot ERROR + +This is depriciated. Don't use it. + +Sends headers and an HTML error message, then exits. + +=cut + +sub eidiot { + #warn "eidiot depriciated"; + idiot(@_); + if (exists $ENV{MOD_PERL}) { + eval { + use Apache; + Apache::exit(); + }; + } else { + exit; + } +} + +=item popurl LEVEL + +Returns current URL with LEVEL levels of path removed from the end (default 0). + +=cut + +sub popurl { + my($up)=@_; + my $cgi = &FS::UID::cgi; + my $url = new URI::URL ( $cgi->isa('Apache') ? $cgi->uri : $cgi->url ); + my(@path)=$url->path_components; + splice @path, 0-$up; + $url->path_components(@path); + my $x = $url->as_string; + $x .= '/' unless $x =~ /\/$/; + $x; +} + +=item table + +Returns HTML tag for beginning a table. + +=cut + +sub table { + my $col = shift; + if ( $col ) { + qq!!; + } else { + "
"; + } +} + +=item itable + +Returns HTML tag for beginning an (invisible) table. + +=cut + +sub itable { + my $col = shift; + my $cellspacing = shift || 0; + if ( $col ) { + qq!
!; + } else { + qq!
!; + } +} + +=item ntable + +This is getting silly. + +=cut + +sub ntable { + my $col = shift; + my $cellspacing = shift || 0; + if ( $col ) { + qq!
!; + } else { + "
"; + } + +} + +=back + +=head1 BUGS + +Not OO. + +Not complete. + +=head1 SEE ALSO + +L, L + +=cut + +1; + + diff --git a/FS/FS/CGIwrapper.pm b/FS/FS/CGIwrapper.pm new file mode 100644 index 000000000..863193e94 --- /dev/null +++ b/FS/FS/CGIwrapper.pm @@ -0,0 +1,17 @@ +package FS::CGIwrapper; + +use vars qw(@ISA); + +use CGI; + +@ISA = qw( CGI ); + +sub header { + my $self = shift; + $self->SUPER::header( + @_, + '-expires' => 'now', + '-pragma' => 'No-Cache', + '-cache-control' => 'No-Cache', + ); +} diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm new file mode 100644 index 000000000..7c6105bdc --- /dev/null +++ b/FS/FS/Conf.pm @@ -0,0 +1,112 @@ +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; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm new file mode 100644 index 000000000..113e1a18d --- /dev/null +++ b/FS/FS/Record.pm @@ -0,0 +1,968 @@ +package FS::Record; + +use strict; +use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG); +use subs qw(reload_dbdef); +use Exporter; +use Carp qw(carp cluck croak confess); +use File::CounterFile; +use DBIx::DBSchema; +use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); + +@ISA = qw(Exporter); +@EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); + +$DEBUG = 0; + +#ask FS::UID to run this stuff for us later +$FS::UID::callback{'FS::Record'} = sub { + $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc; + $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc; + &reload_dbdef unless $setup_hack; #$setup_hack needed now? +}; + +=head1 NAME + +FS::Record - Database record objects + +=head1 SYNOPSIS + + use FS::Record; + use FS::Record qw(dbh fields qsearch qsearchs dbdef); + + $record = new FS::Record 'table', \%hash; + $record = new FS::Record 'table', { 'column' => 'value', ... }; + + $record = qsearchs FS::Record 'table', \%hash; + $record = qsearchs FS::Record 'table', { 'column' => 'value', ... }; + @records = qsearch FS::Record 'table', \%hash; + @records = qsearch FS::Record 'table', { 'column' => 'value', ... }; + + $table = $record->table; + $dbdef_table = $record->dbdef_table; + + $value = $record->get('column'); + $value = $record->getfield('column'); + $value = $record->column; + + $record->set( 'column' => 'value' ); + $record->setfield( 'column' => 'value' ); + $record->column('value'); + + %hash = $record->hash; + + $hashref = $record->hashref; + + $error = $record->insert; + #$error = $record->add; #depriciated + + $error = $record->delete; + #$error = $record->del; #depriciated + + $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #depriciated + + $value = $record->unique('column'); + + $value = $record->ut_float('column'); + $value = $record->ut_number('column'); + $value = $record->ut_numbern('column'); + $value = $record->ut_money('column'); + $value = $record->ut_text('column'); + $value = $record->ut_textn('column'); + $value = $record->ut_alpha('column'); + $value = $record->ut_alphan('column'); + $value = $record->ut_phonen('column'); + $value = $record->ut_anythingn('column'); + + $dbdef = reload_dbdef; + $dbdef = reload_dbdef "/non/standard/filename"; + $dbdef = dbdef; + + $quoted_value = _quote($value,'table','field'); + + #depriciated + $fields = hfields('table'); + if ( $fields->{Field} ) { # etc. + + @fields = fields 'table'; #as a subroutine + @fields = $record->fields; #as a method call + + +=head1 DESCRIPTION + +(Mostly) object-oriented interface to database records. Records are currently +implemented on top of DBI. FS::Record is intended as a base class for +table-specific classes to inherit from, i.e. FS::cust_main. + +=head1 CONSTRUCTORS + +=over 4 + +=item new [ TABLE, ] HASHREF + +Creates a new record. It doesn't store it in the database, though. See +L<"insert"> for that. + +Note that the object stores this hash reference, not a distinct copy of the +hash it points to. You can ask the object for a copy with the I +method. + +TABLE can only be omitted when a dervived class overrides the table method. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + + $self->{'Table'} = shift unless defined ( $self->table ); + + my $hashref = $self->{'Hash'} = shift; + + foreach my $field ( $self->fields ) { + $hashref->{$field}='' unless defined $hashref->{$field}; + #trim the '$' and ',' from money fields for Pg (belong HERE?) + #(what about Pg i18n?) + if ( driver_name =~ /^Pg$/i + && $self->dbdef_table->column($field)->type eq 'money' ) { + ${$hashref}{$field} =~ s/^\$//; + ${$hashref}{$field} =~ s/\,//; + } + } + + $self; +} + +sub create { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + if ( defined $self->table ) { + cluck "create constructor is depriciated, use new!"; + $self->new(@_); + } else { + croak "FS::Record::create called (not from a subclass)!"; + } +} + +=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL + +Searches the database for all records matching (at least) the key/value pairs +in HASHREF. Returns all the records found as `FS::TABLE' objects if that +module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record +objects. + +###oops, argh, FS::Record::new only lets us create database fields. +#Normal behaviour if SELECT is not specified is `*', as in +#C +
+ + + + + + + + + + + + + + +
+ Welcome +
+ Username + + +
+ Password + + +
+ +
+ + + +END + +} + +sub print_okay { + print $cgi->header( '-expires' => 'now' ), <login sucessful +login successful, etc. + + +END +} + +sub usage { + die "Usage:\n\n freeside-login username ( portnum | ip | nasnum nasport )"; +} diff --git a/fs_sesmon/FS-SessionClient/cgi/logout.cgi b/fs_sesmon/FS-SessionClient/cgi/logout.cgi new file mode 100644 index 000000000..95cef98d1 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/cgi/logout.cgi @@ -0,0 +1,83 @@ +#!/usr/bin/perl -Tw + +#false-laziness hack w login.cgi + +use strict; +use vars qw( $cgi $username $password $error $ip $portnum ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::SessionClient qw( logout portnum ); + +$cgi = new CGI; + +if ( defined $cgi->param('magic') ) { + $cgi->param('username') =~ /^\s*(\w{1,255})\s*$/ or do { + $error = "Illegal username"; + &print_form; + exit; + }; + $username = $1; + $cgi->param('password') =~ /^([^\n]{0,255})$/ or die "guru meditation #420"; + $password = $1; + #$ip = $cgi->remote_host; + $ip = $ENV{REMOTE_ADDR}; + $ip =~ /^([\d\.]+)$/ or die "illegal ip: $ip"; + $ip = $1; + $portnum = portnum( { 'ip' => $1 } ) or do { + $error = "You appear to be coming from an unknown IP address. Verify ". + "that your computer is set to obtain an IP address automatically ". + "via DHCP."; + &print_form; + exit; + }; + + ( $error = logout ( { + 'username' => $username, + 'portnum' => $portnum, + 'password' => $password, + } ) ) + ? &print_form() + : &print_okay(); + +} else { + $username = ''; + $password = ''; + $error = ''; + &print_form; +} + +sub print_form { + my $self_url = $cgi->self_url; + + print $cgi->header( '-expires' => 'now' ), <logout + +END + +print qq!Error: $error! if $error; + +print < + +Username
+Password
+ + + + +END + +} + +sub print_okay { + print $cgi->header( '-expires' => 'now' ), <logout sucessful +logout successful, etc. + + +END +} + +sub usage { + die "Usage:\n\n freeside-logout username ( portnum | ip | nasnum nasport )"; +} diff --git a/fs_sesmon/FS-SessionClient/fs_sessiond b/fs_sesmon/FS-SessionClient/fs_sessiond new file mode 100644 index 000000000..bfdb20a1d --- /dev/null +++ b/fs_sesmon/FS-SessionClient/fs_sessiond @@ -0,0 +1,65 @@ +#!/usr/bin/perl -Tw +# +# fs_sessiond +# +# This is run REMOTELY over ssh by fs_session_server +# + +use strict; +use Socket; + +use vars qw( $Debug ); + +$Debug = 1; + +my $fs_sessiond_socket = "/usr/local/freeside/fs_sessiond_socket"; + +$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +$|=1; + +my $me = "[fs_sessiond]"; + +warn "$me starting\n" if $Debug; +#nothing to read from server + +warn "$me creating $fs_sessiond_socket\n" if $Debug; +my $uaddr = sockaddr_un($fs_sessiond_socket); +my $proto = getprotobyname('tcp'); +socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!"; +unlink($fs_sessiond_socket); +bind(Server, $uaddr) or die "bind: $!"; +listen(Server,SOMAXCONN) or die "listen: $!"; + +warn "$me entering main loop\n" if $Debug; +my $paddr; +for ( ; $paddr = accept(Client,Server); close Client) { + + chomp( my $command = ); + + if ( $command eq 'login' || $command eq 'logout' || $command eq 'portnum' ) { + warn "$me reading data from local client\n" if $Debug; + my @data; + my $dos = 0; + push @data, scalar() until $dos++ == 99 || $data[$#data] eq "END\n"; + if ( $dos == 99 ) { + warn "$me WARNING: DoS attempt!" + } else { + warn "$me sending data to remote server\n" if $Debug; + print "$command\n", @data; + warn "$me reading result from remote server\n" if $Debug; + my $error = ; + warn "$me sending error to local client\n" if $Debug; + print Client $error; + } + } else { + warn "$me WARNING: unexpected command from client: $command"; + } + +} + diff --git a/fs_sesmon/FS-SessionClient/test.pl b/fs_sesmon/FS-SessionClient/test.pl new file mode 100644 index 000000000..4b9ae17e0 --- /dev/null +++ b/fs_sesmon/FS-SessionClient/test.pl @@ -0,0 +1,21 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +#use FS::SessionClient; +#sigh, "not running as the freeside user" +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + diff --git a/fs_sesmon/fs_session_server b/fs_sesmon/fs_session_server new file mode 100644 index 000000000..00229f8dc --- /dev/null +++ b/fs_sesmon/fs_session_server @@ -0,0 +1,140 @@ +#!/usr/bin/perl -Tw +# +# fs_session_server +# + +use strict; +use vars qw( $opt $Debug ); +use IO::Handle; +use Net::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw( qsearchs ); #qsearch ); +#use FS::cust_main_county; +#use FS::cust_main; +use FS::session; +use FS::port; +use FS::svc_acct; + +#require "configfile"; +$Debug = 1; + +my $user = shift or die &usage; +&adminsuidsetup( $user ); + +my $machine = shift or die &usage; + +my $fs_sessiond = "/usr/local/sbin/fs_sessiond"; + +my $me = "[fs_session_server]"; + +while (1) { + my($reader, $writer) = (new IO::Handle, new IO::Handle); + $writer->autoflush(1); + warn "$me Connecting to $machine\n" if $Debug; + sshopen2($machine,$reader,$writer,$fs_sessiond); + + warn "$me Entering main loop\n" if $Debug; + while (1) { + warn "$me Reading (waiting for) data\n" if $Debug; + my $command = scalar(<$reader>); + chomp $command; + #DoS protection here too, to protect against a compromised client? *sigh* + my %hash; + while ( ( my $key = scalar(<$reader>) ) ne "END\n" ) { + chomp $key; + chomp( $hash{$key} = scalar(<$reader>) ); + } + + if ( $command eq 'login' ) { + my $error = &login(\%hash); + print $writer "$error\n"; + } elsif ( $command eq 'logout' ) { + my $error = &logout(\%hash); + print $writer "$error\n"; + } elsif ( $command eq 'portnum' ) { + my $port; + if ( exists $hash{'ip'} ) { + $hash{'ip'} =~ /^([\d\.]+)$/ or $1='nomatch'; + $port = qsearchs('port', { 'ip' => $1 } ); + } else { + $hash{'nasnum'} =~ /^(\d+)$/ and my $nasnum = $1; + $hash{'nasport'} =~ /^(\d+)$/ and my $nasport = $1; + $port = qsearchs('port', { 'nasnum'=>$nasnum, 'nasport'=>$nasport } ); + } + print $writer ( $port ? $port->portnum : '' ), "\n"; + } else { + warn "$me WARNING: unrecognized command: $command"; + } + } + #won't ever reach without code above to throw out of loop, but... + close $writer; + close $reader; + warn "connection to $machine lost!\n"; + sleep 5; + warn "reconnecting...\n"; +} + +sub login { + my $href = shift; + $href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username"; + my $username = $1; + my $svc_acct = qsearchs('svc_acct', { 'username' => $username } ) + or return "Unknown user"; + return "Incorrect password" + if exists($href->{'password'}) + && $href->{'password'} ne $svc_acct->_password; + return "Time limit exceeded" unless $svc_acct->seconds; + my $session = new FS::session { + 'portnum' => $href->{'portnum'}, + 'svcnum' => $svc_acct->svcnum, + 'login' => $href->{'login'}, + }; + $session->insert; +} + +sub logout { + my $href = shift; + $href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username"; + my $username = $1; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $svc_acct = + qsearchs('svc_acct', { 'username' => $username }, '', 'FOR UPDATE' ) + or return "Unknown user"; + return "Incorrect password" + if exists($href->{'password'}) + && $href->{'password'} ne $svc_acct->_password; + my $session = qsearchs( 'session', { + 'portnum' => $href->{'portnum'}, + 'svcnum' => $svc_acct->svcnum, + 'logout' => '', + }, + '', 'FOR UPDATE' + ); + unless ( $session ) { + $dbh->rollback; + return "No currently open sessions found for that user/port!"; + } + my $nsession = new FS::session ( { $session->hash } ); + warn "$nsession replacing $session"; + my $error = $nsession->replace($session); + if ( $error ) { + $dbh->rollback; + return "can't logout: $error"; + } + my $time = $nsession->logout - $nsession->login; + my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } ); + my $seconds = $new_svc_acct->seconds; + $seconds -= $time; + $seconds = 0 if $seconds < 0; + $new_svc_acct->seconds( $seconds ); + $error = $new_svc_acct->replace( $svc_acct ); + warn "can't debit time: $error\n"; #don't want to rollback, though + $dbh->commit or die $dbh->errstr; + '' +} + +sub usage { + die "Usage:\n\n fs_session_server user machine\n"; +} + diff --git a/fs_signup/FS-SignupClient/Changes b/fs_signup/FS-SignupClient/Changes new file mode 100644 index 000000000..e750a82bc --- /dev/null +++ b/fs_signup/FS-SignupClient/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension FS::SignupClient. + +0.01 Mon Aug 23 01:12:46 1999 + - original version; created by h2xs 1.19 + diff --git a/fs_signup/FS-SignupClient/MANIFEST b/fs_signup/FS-SignupClient/MANIFEST new file mode 100644 index 000000000..b4a9900c8 --- /dev/null +++ b/fs_signup/FS-SignupClient/MANIFEST @@ -0,0 +1,8 @@ +Changes +MANIFEST +MANIFEST.SKIP +Makefile.PL +SignupClient.pm +test.pl +fs_signupd +cgi/signup.cgi diff --git a/fs_signup/FS-SignupClient/MANIFEST.SKIP b/fs_signup/FS-SignupClient/MANIFEST.SKIP new file mode 100644 index 000000000..ae335e78a --- /dev/null +++ b/fs_signup/FS-SignupClient/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/fs_signup/FS-SignupClient/Makefile.PL b/fs_signup/FS-SignupClient/Makefile.PL new file mode 100644 index 000000000..859d757c3 --- /dev/null +++ b/fs_signup/FS-SignupClient/Makefile.PL @@ -0,0 +1,10 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'FS::SignupClient', + 'VERSION_FROM' => 'SignupClient.pm', # finds $VERSION + 'EXE_FILES' => [ 'fs_signupd' ], + 'INSTALLSCRIPT' => '/usr/local/sbin', + 'PERM_RWX' => '750', +); diff --git a/fs_signup/FS-SignupClient/SignupClient.pm b/fs_signup/FS-SignupClient/SignupClient.pm new file mode 100644 index 000000000..5769c18fc --- /dev/null +++ b/fs_signup/FS-SignupClient/SignupClient.pm @@ -0,0 +1,218 @@ +package FS::SignupClient; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK $fs_signupd_socket); +use Exporter; +use Socket; +use FileHandle; +use IO::Handle; + +$VERSION = '0.01'; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( signup_info new_customer ); + +$fs_signupd_socket = "/usr/local/freeside/fs_signupd_socket"; + +$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +my $freeside_uid = scalar(getpwnam('freeside')); +die "not running as the freeside user\n" if $> != $freeside_uid; + +=head1 NAME + +FS::SignupClient - Freeside signup client API + +=head1 SYNOPSIS + + use FS::SignupClient qw( signup_info new_customer ); + + ( $locales, $packages, $pops ) = signup_info; + + $error = new_customer ( { + 'first' => $first, + 'last' => $last, + 'ss' => $ss, + 'comapny' => $company, + 'address1' => $address1, + 'address2' => $address2, + 'city' => $city, + 'county' => $county, + 'state' => $state, + 'zip' => $zip, + 'country' => $country, + 'daytime' => $daytime, + 'night' => $night, + 'fax' => $fax, + 'payby' => $payby, + 'payinfo' => $payinfo, + 'paydate' => $paydate, + 'payname' => $payname, + 'invoicing_list' => $invoicing_list, + 'pkgpart' => $pkgpart, + 'username' => $username, + '_password' => $password, + 'popnum' => $popnum, + } ); + +=head1 DESCRIPTION + +This module provides an API for a remote signup server. + +It needs to be run as the freeside user. Because of this, the program which +calls these subroutines should be written very carefully. + +=head1 SUBROUTINES + +=over 4 + +=item signup_info + +Returns three array references of hash references. + +The first set of hash references is of allowable locales. Each hash reference +has the following keys: + taxnum + state + county + country + +The second set of hash references is of allowable packages. Each hash +reference has the following keys: + pkgpart + pkg + +The third set of hash references is of allowable POPs (Points Of Presence). +Each hash reference has the following keys: + popnum + city + state + ac + exch + +=cut + +sub signup_info { + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_signupd_socket)) or die "connect: $!"; + print SOCK "signup_info\n"; + SOCK->flush; + + chop ( my $n_cust_main_county = ); + my @cust_main_county = map { + chop ( my $taxnum = ); + chop ( my $state = ); + chop ( my $county = ); + chop ( my $country = ); + { + 'taxnum' => $taxnum, + 'state' => $state, + 'county' => $county, + 'country' => $country, + }; + } 1 .. $n_cust_main_county; + + chop ( my $n_part_pkg = ); + my @part_pkg = map { + chop ( my $pkgpart = ); + chop ( my $pkg = ); + { + 'pkgpart' => $pkgpart, + 'pkg' => $pkg, + }; + } 1 .. $n_part_pkg; + + chop ( my $n_svc_acct_pop = ); + my @svc_acct_pop = map { + chop ( my $popnum = ); + chop ( my $city = ); + chop ( my $state = ); + chop ( my $ac = ); + chop ( my $exch = ); + chop ( my $loc = ); + { + 'popnum' => $popnum, + 'city' => $city, + 'state' => $state, + 'ac' => $ac, + 'exch' => $exch, + 'loc' => $loc, + }; + } 1 .. $n_svc_acct_pop; + + close SOCK; + + \@cust_main_county, \@part_pkg, \@svc_acct_pop; +} + +=item new_customer HASHREF + +Adds a customer to the remote Freeside system. Requires a hash reference as +a paramater with the following keys: + first + last + ss + comapny + address1 + address2 + city + county + state + zip + country + daytime + night + fax + payby + payinfo + paydate + payname + invoicing_list + pkgpart + username + _password + popnum + +Returns a scalar error message, or the empty string for success. + +=cut + +sub new_customer { + my $hashref = shift; + + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($fs_signupd_socket)) or die "connect: $!"; + print SOCK "new_customer\n"; + + print SOCK join("\n", map { $hashref->{$_} } qw( + first last ss company address1 address2 city county state zip country + daytime night fax payby payinfo paydate payname invoicing_list + pkgpart username _password popnum + ) ), "\n"; + SOCK->flush; + + chop( my $error = ); + $error; +} + +=back + +=head1 VERSION + +$Id: SignupClient.pm,v 1.3 2000-02-02 07:44:00 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L + +=cut + +1; + diff --git a/fs_signup/FS-SignupClient/cgi/signup.cgi b/fs_signup/FS-SignupClient/cgi/signup.cgi new file mode 100755 index 000000000..a3fa9e788 --- /dev/null +++ b/fs_signup/FS-SignupClient/cgi/signup.cgi @@ -0,0 +1,384 @@ +#!/usr/bin/perl -Tw +# +# $Id: signup.cgi,v 1.9 2000-12-03 14:29:15 ivan Exp $ + +use strict; +use vars qw( @payby $cgi $locales $packages $pops $r $error + $last $first $ss $company $address1 $address2 $city $state $county + $country $zip $daytime $night $fax $invoicing_list $payby $payinfo + $paydate $payname $pkgpart $username $password $popnum + $ieak_file $ieak_template $cck_file $cck_template + $ac $exch $loc + ); +use subs qw( print_form print_okay expselect ); + +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use HTTP::Headers::UserAgent 2.00; +use FS::SignupClient qw( signup_info new_customer ); +use Text::Template; + +#acceptable payment methods +# +#@payby = qw( CARD BILL COMP ); +#@payby = qw( CARD BILL ); +#@payby = qw( CARD ); +@payby = qw( CARD PREPAY ); + +$ieak_file = '/usr/local/freeside/ieak.template'; +$cck_file = '/usr/local/freeside/cck.template'; + +if ( -e $ieak_file ) { + my $ieak_txt = Text::Template::_load_text($ieak_file) + or die $Text::Template::ERROR; + $ieak_txt =~ /^(.*)$/s; #untaint the template source - it's trusted + $ieak_txt = $1; + $ieak_template = new Text::Template ( TYPE => 'STRING', SOURCE => $ieak_txt ) + or die $Text::Template::ERROR; +} else { + $ieak_template = ''; +} +if ( -e $cck_file ) { + my $cck_txt = Text::Template::_load_text($cck_file) + or die $Text::Template::ERROR; + $cck_txt =~ /^(.*)$/s; #untaint the template source - it's trusted + $cck_txt = $1; + $cck_template = new Text::Template ( TYPE => 'STRING', SOURCE => $cck_txt ) + or die $Text::Template::ERROR; +} else { + $cck_template = ''; +} + +( $locales, $packages, $pops ) = signup_info(); + +$cgi = new CGI; + +if ( defined $cgi->param('magic') ) { + if ( $cgi->param('magic') eq 'process' ) { + + $cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/ + or die "Oops, illegal \"state\" param: ". $cgi->param('state'); + $state = $1; + $county = $3 || ''; + $country = $4; + + $payby = $cgi->param('payby'); + $payinfo = $cgi->param( $payby. '_payinfo' ); + $paydate = + $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' ); + $payname = $cgi->param( $payby. '_payname' ); + + if ( $invoicing_list = $cgi->param('invoicing_list') ) { + $invoicing_list .= ', POST' if $cgi->param('invoicing_list_POST'); + } else { + $invoicing_list = 'POST'; + } + + ( $error = new_customer ( { + 'last' => $last = $cgi->param('last'), + 'first' => $first = $cgi->param('first'), + 'ss' => $ss = $cgi->param('ss'), + 'company' => $company = $cgi->param('company'), + 'address1' => $address1 = $cgi->param('address1'), + 'address2' => $address2 = $cgi->param('address2'), + 'city' => $city = $cgi->param('city'), + 'county' => $county, + 'state' => $state, + 'zip' => $zip = $cgi->param('zip'), + 'country' => $country, + 'daytime' => $daytime = $cgi->param('daytime'), + 'night' => $night = $cgi->param('night'), + 'fax' => $fax = $cgi->param('fax'), + 'payby' => $payby, + 'payinfo' => $payinfo, + 'paydate' => $paydate, + 'payname' => $payname, + 'invoicing_list' => $invoicing_list, + 'pkgpart' => $pkgpart = $cgi->param('pkgpart'), + 'username' => $username = $cgi->param('username'), + '_password' => $password = $cgi->param('_password'), + 'popnum' => $popnum = $cgi->param('popnum'), + } ) ) + ? print_form() + : print_okay(); + } else { + die "unrecognized magic: ". $cgi->param('magic'); + } +} else { + $error = ''; + $last = ''; + $first = ''; + $ss = ''; + $company = ''; + $address1 = ''; + $address2 = ''; + $city = ''; + $state = ''; + $county = ''; + $country = ''; + $zip = ''; + $daytime = ''; + $night = ''; + $fax = ''; + $invoicing_list = ''; + $payby = ''; + $payinfo = ''; + $paydate = ''; + $payname = ''; + $pkgpart = ''; + $username = ''; + $password = ''; + $popnum = ''; + + print_form; +} + +sub print_form { + + my $r = qq!*!; + my $self_url = $cgi->self_url; + + print $cgi->header( '-expires' => 'now' ), <ISP Signup form +ISP Signup form

+END + + print qq!Error: $error! if $error; + + print < + +Contact Information + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
${r}Contact name
(last, first)
, + SS#
Company
${r}Address
 
${r}City${r}State/Country${r}Zip
Day Phone
Night Phone
Fax
$r required fields
+
Billing information +!; + + print <
+END + + print qq!Postal mail invoice
Email invoice ', + qq!
Billing type
+ + +END + + my %payby = ( + 'CARD' => qq!Credit card
${r}
${r}Exp !. expselect("CARD"). qq!
${r}Name on card
!, + 'BILL' => qq!Billing
P.O.
${r}Exp !. expselect("BILL", "12-2037"). qq!
${r}Attention
!, + 'COMP' => qq!Complimentary
${r}Approved by
${r}Exp !. expselect("COMP"), + 'PREPAY' => qq!Prepaid card
${r}!, + ); + + my %paybychecked = ( + 'CARD' => qq!Credit card
${r}
${r}Exp !. expselect("CARD", $paydate). qq!
${r}Name on card
!, + 'BILL' => qq!Billing
P.O.
${r}Exp !. expselect("BILL", $paydate). qq!
${r}Attention
!, + 'COMP' => qq!Complimentary
${r}Approved by
${r}Exp !. expselect("COMP", $paydate), + 'PREPAY' => qq!Prepaid card
${r}!, + ); + + for (@payby) { + print qq!!; + } else { + print qq!> $payby{$_}!; + } + } + + print <
$paybychecked{$_}
$r required fields for each billing type +

First package + + + + + + + + + + + + + + + + +
Username
Password + (blank to generate)
POP
+

+ +END + +} + +sub print_okay { + my $user_agent = new HTTP::Headers::UserAgent $ENV{HTTP_USER_AGENT}; + + $cgi->param('username') =~ /^(.+)$/ + or die "fatal: invalid username got past FS::SignupClient::new_customer"; + my $username = $1; + $cgi->param('_password') =~ /^(.+)$/ + or die "fatal: invalid password got past FS::SignupClient::new_customer"; + my $password = $1; + ( $cgi->param('first'). ' '. $cgi->param('last') ) =~ /^(.*)$/ + or die "fatal: invalid email_name got past FS::SignupCLient::new_customer"; + my $email_name = $1; + + my $pop = pop_info($cgi->param('popnum')) + or die "fatal: invalid popnum got past FS::SignupClient::new_customer"; + ( $ac, $exch, $loc ) = ( $pop->{'ac'}, $pop->{'exch'}, $pop->{'loc'} ); + + if ( $ieak_template + && $user_agent->platform eq 'ia32' + && $user_agent->os =~ /^win/ + && ($user_agent->browser)[0] eq 'IE' + ) + { #send an IEAK config + print $cgi->header('application/x-Internet-signup'), + $ieak_template->fill_in(); + } elsif ( $cck_template + && $user_agent->platform eq 'ia32' + && $user_agent->os =~ /^win/ + && ($user_agent->browser)[0] eq 'Netscape' + ) + { #send a Netscape config + my $cck_data = $cck_template->fill_in(); + print $cgi->header('application/x-netscape-autoconfigure-dialer-v2'), + map { + m/(.*)\s+(.*)$/; + pack("N", length($1)). $1. pack("N", length($2)). $2; + } split(/\n/, $cck_data); + + } else { #send a simple confirmation + print $cgi->header( '-expires' => 'now' ), <Signup successful +Signup successful

+blah blah blah + + +END + } +} + +sub pop_info { + my $popnum = shift; + my $pop; + foreach $pop ( @{$pops} ) { + if ( $pop->{'popnum'} == $popnum ) { return $pop; } + } + ''; +} + +sub expselect { + my $prefix = shift; + my $date = shift || ''; + my( $m, $y ) = ( 0, 0 ); + if ( $date =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #PostgreSQL date format + ( $m, $y ) = ( $2, $1 ); + } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $m, $y ) = ( $1, $3 ); + } + my $return = qq!!; + for ( 1999 .. 2037 ) { + $return .= " ); +my @cust_main_county = map { + chomp( my $taxnum = ); + chomp( my $state = ); + chomp( my $county = ); + chomp( my $country = ); + { + 'taxnum' => $taxnum, + 'state' => $state, + 'county' => $county, + 'country' => $country, + }; +} ( 1 .. $n_cust_main_county ); + +warn "[fs_signupd] Reading package definitions...\n" if $Debug; +chomp( my $n_part_pkg = ); +my @part_pkg = map { + chomp( my $pkgpart = ); + chomp( my $pkg = ); + { + 'pkgpart' => $pkgpart, + 'pkg' => $pkg, + }; +} ( 1 .. $n_part_pkg ); + +warn "[fs_signupd] Reading POPs...\n" if $Debug; +chomp( my $n_svc_acct_pop = ); +my @svc_acct_pop = map { + chomp( my $popnum = ); + chomp( my $city = ); + chomp( my $state = ); + chomp( my $ac = ); + chomp( my $exch = ); + chomp( my $loc = ); + { + 'popnum' => $popnum, + 'city' => $city, + 'state' => $state, + 'ac' => $ac, + 'exch' => $exch, + 'loc' => $loc, + }; +} ( 1 .. $n_svc_acct_pop ); + +warn "[fs_signupd] Creating $fs_signupd_socket\n" if $Debug; +my $uaddr = sockaddr_un($fs_signupd_socket); +my $proto = getprotobyname('tcp'); +socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!"; +unlink($fs_signupd_socket); +bind(Server, $uaddr) or die "bind: $!"; +listen(Server,SOMAXCONN) or die "listen: $!"; + +warn "[fs_signupd] Entering main loop...\n" if $Debug; +my $paddr; +for ( ; $paddr = accept(Client,Server); close Client) { + + chop( my $command = ); + + if ( $command eq "signup_info" ) { + warn "[fs_signupd] sending signup info...\n" if $Debug; + print Client join("\n", $n_cust_main_county, + map { + $_->{taxnum}, + $_->{state}, + $_->{county}, + $_->{country}, + } @cust_main_county + ), "\n"; + + print Client join("\n", $n_part_pkg, + map { + $_->{pkgpart}, + $_->{pkg}, + } @part_pkg + ), "\n"; + + print Client join("\n", $n_svc_acct_pop, + map { + $_->{popnum}, + $_->{city}, + $_->{state}, + $_->{ac}, + $_->{exch}, + $_->{loc}, + } @svc_acct_pop + ), "\n"; + + } elsif ( $command eq "new_customer" ) { + warn "[fs_signupd] reading customer signup...\n" if $Debug; + my( + $first, $last, $ss, $company, $address1, $address2, $city, $county, + $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo, + $paydate, $payname, $invoicing_list, $pkgpart, $username, $password, + $popnum, + ) = map { scalar() } ( 1 .. 23 ); + + warn "[fs_signupd] sending customer data to remote server...\n" if $Debug; + print + $first, $last, $ss, $company, $address1, $address2, $city, $county, + $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo, + $paydate, $payname, $invoicing_list, $pkgpart, $username, $password, + $popnum, + ; + + warn "[fs_signupd] reading error from remote server...\n" if $Debug; + my $error = ; + + warn "[fs_signupd] sending error to local client...\n" if $Debug; + print Client $error; + + } else { + die "unexpected command from client: $command"; + } + +} + diff --git a/fs_signup/FS-SignupClient/test.pl b/fs_signup/FS-SignupClient/test.pl new file mode 100644 index 000000000..690f5840e --- /dev/null +++ b/fs_signup/FS-SignupClient/test.pl @@ -0,0 +1,20 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use FS::SignupClient; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + diff --git a/fs_signup/cck.template b/fs_signup/cck.template new file mode 100644 index 000000000..f1db554b1 --- /dev/null +++ b/fs_signup/cck.template @@ -0,0 +1,14 @@ +SITE_FILE 8chrfile +SITE_NAME YourISP +LOGIN { $username } +PASSWORD { $password } +PHONE_NUM +1({ $ac }){ $exch }-{ $loc } +DNS_ADDR 10.0.0.1 +DNS_ADDR2 10.0.0.2 +NNTP_HOST news.yourisp.com +SMTP_HOST mail.yourisp.com +DOMAIN_NAME yourisp.com +POP_SERVER { $username }@mail.yourisp.com +POP_PASSWORD { $password } +HOME_URL http://www.yourisp.com +EMAIL_ADDR { $username }@yourisp.com diff --git a/fs_signup/fs_signup_server b/fs_signup/fs_signup_server new file mode 100755 index 000000000..8fbc819ad --- /dev/null +++ b/fs_signup/fs_signup_server @@ -0,0 +1,194 @@ +#!/usr/bin/perl -Tw +# +# fs_signup_server +# + +use strict; +use IO::Handle; +use Tie::RefHash; +use Net::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main_county; +use FS::cust_main; + +use vars qw( $opt $Debug ); + +$Debug = 0; + +my @payby = qw(CARD PREPAY); + +my $user = shift or die &usage; +&adminsuidsetup( $user ); + +my $machine = shift or die &usage; + +my $agentnum = shift or die &usage; +my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage; +my $pkgpart = $agent->pkgpart_hashref; + +my $refnum = shift or die &usage; + +#causing trouble for some folks +#$SIG{CHLD} = sub { wait() }; + +my($fs_signupd)="/usr/local/sbin/fs_signupd"; + +while (1) { + my($reader,$writer)=(new IO::Handle, new IO::Handle); + $writer->autoflush(1); + warn "[fs_signup_server] Connecting to $machine...\n" if $Debug; + sshopen2($machine,$reader,$writer,$fs_signupd); + + my $data; + + warn "[fs_signup_server] Sending locales...\n" if $Debug; + my @cust_main_county = qsearch('cust_main_county', {} ); + print $writer $data = join("\n", + ( scalar(@cust_main_county) || die "no tax rates (cust_main_county records)" ), + map { + $_->taxnum, + $_->state, + $_->county, + $_->country, + } @cust_main_county + ),"\n"; + warn "[fs_signup_server] $data\n" if $Debug > 2; + + warn "[fs_signup_server] Sending package definitions...\n" if $Debug; + my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } } + qsearch( 'part_pkg', {} ); + print $writer $data = join("\n", + ( scalar(@part_pkg) || die "no usable package definitions, agent $agentnum" ), + map { + $_->pkgpart, + $_->pkg, + } @part_pkg + ), "\n"; + warn "[fs_signup_server] $data\n" if $Debug > 2; + + warn "[fs_signup_server] Sending POPs...\n" if $Debug; + my @svc_acct_pop = qsearch ('svc_acct_pop',{} ); + print $writer $data = join("\n", + ( scalar(@svc_acct_pop) || die "No points of presence (svc_acct_pop records)" ), + map { + $_->popnum, + $_->city, + $_->state, + $_->ac, + $_->exch, + $_->loc, + } @svc_acct_pop + ), "\n"; + warn "[fs_signup_server] $data\n" if $Debug > 2; + + warn "[fs_signup_server] Entering main loop...\n" if $Debug; + while (1) { + warn "[fs_signup_server] Reading (waiting for) signup data...\n" if $Debug; + chop( my( + $first, $last, $ss, $company, $address1, $address2, $city, $county, + $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo, + $paydate, $payname, $invoicing_list, $pkgpart, $username, $password, + $popnum, + ) = map { scalar(<$reader>) } ( 1 .. 23 ) ); + + warn "[fs_signup_server] Processing signup...\n" if $Debug; + + my $error = ''; + + #shares some stuff with htdocs/edit/process/cust_main.cgi... take any + # common that are still here and library them. + my $cust_main = new FS::cust_main ( { + 'custnum' => '', + 'agentnum' => $agentnum, + 'refnum' => $refnum, + 'last' => $last, + 'first' => $first, + 'ss' => $ss, + 'company' => $company, + 'address1' => $address1, + 'address2' => $address2, + 'city' => $city, + 'county' => $county, + 'state' => $state, + 'zip' => $zip, + 'country' => $country, + 'daytime' => $daytime, + 'night' => $night, + 'fax' => $fax, + 'payby' => $payby, + 'payinfo' => $payinfo, + 'paydate' => $paydate, + 'payname' => $payname, + } ); + + $error = "Illegal payment type" unless grep { $_ eq $payby } @payby; + + my @invoicing_list = split( /\s*\,\s*/, $invoicing_list ); + + $error ||= $cust_main->check_invoicing_list( \@invoicing_list ); + + my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $pkgpart } ) + or $error ||= "WARNING: unknown pkgpart $pkgpart"; + my $svcpart = $part_pkg->svcpart unless $error; + + # this should wind up in FS::cust_pkg! + my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ); + my $pkgpart_href = $agent->pkgpart_hashref; + $error ||= "WARNING: agent $agentnum can't purchase pkgpart $pkgpart" + unless $pkgpart_href->{ $pkgpart }; + + my $cust_pkg = new FS::cust_pkg ( { + #later#'custnum' => $custnum, + 'pkgpart' => $pkgpart, + } ); + $error ||= $cust_pkg->check; + + my $svc_acct = new FS::svc_acct ( { + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'popnum' => $popnum, + } ); + + my $y = $svc_acct->setdefault; # arguably should be in new method + $error ||= $y unless ref($y); + #and just in case you were silly + $svc_acct->svcpart($svcpart); + $svc_acct->username($username); + $svc_acct->_password($password); + $svc_acct->popnum($popnum); + + $error ||= $svc_acct->check; + + use Tie::RefHash; + tie my %hash, 'Tie::RefHash'; + %hash = { $cust_pkg => [ $svc_acct ] }; + $error ||= $cust_main->insert( \%hash ); + #if ( $cust_pkg && ! $error ) { #in this case, $cust_pkg should always + # #be definied, but.... + # $cust_pkg->custnum( $cust_main->custnum ); + # $error ||= $cust_pkg->insert; + # warn "WARNING: $error on pre-checked cust_pkg record!" if $error; + # $svc_acct->pkgnum( $cust_pkg->pkgnum ); + # $error ||= $svc_acct->insert; + # warn "WARNING: $error on pre-checked svc_acct record!" if $error; + #} + + warn "[fs_signup_server] Sending results...\n" if $Debug; + print $writer $error, "\n"; + + $cust_main->invoicing_list( \@invoicing_list ) unless $error; + + } + close $writer; + close $reader; + warn "connection to $machine lost! waiting 60 seconds...\n"; + sleep 60; + warn "reconnecting...\n"; +} + +sub usage { + die "Usage:\n\n fs_signup_server user machine agentnum refnum\n"; +} + diff --git a/fs_signup/ieak.template b/fs_signup/ieak.template new file mode 100755 index 000000000..5da2a2036 --- /dev/null +++ b/fs_signup/ieak.template @@ -0,0 +1,40 @@ +[Entry]\r +Entry_Name = The Internet\r +[Phone]\r +Dial_As_Is=no\r +Phone_Number = { $exch. $loc }\r +Area_Code = { $ac }\r +Country_Code = 1\r +Country_Id = 1\r +[Server]\r +Type = PPP\r +SW_Compress = Yes\r +PW_Encrypt = Yes\r +Negotiate_TCP/IP = Yes\r +Disable_LCP = No\r +[TCP/IP]\r +Specify_IP_Address = No\r +Specity_Server_Address = No\r +IP_Header_Compress = Yes\r +Gateway_On_Remote = Yes\r +[User]\r +Name = { $username }\r +Password = { $password }\r +Display_Password = Yes\r +[Internet_Mail]\r +Email_Name = { $email_name }\r +Email_Address = { $username }\@domain.tld\r +POP_Server = mail.domain.tld\r +POP_Server_Port_Number = 110\r +POP_Login_Name = { $username }\r +POP_Login_Password = { $password }\r +SMTP_Server = mail.domain.tld\r +SMTP_Server_Port_Number = 25\r +Install_Mail = 1\r +[Internet_News]\r +NNTP_Server = news.domain.tld\r +NNTP_Server_Port_Number = 119\r +Logon_Required = No\r +Install_News = 1\r +[Branding]\r +Window_Title = The Internet\r diff --git a/fs_webdemo/register.cgi b/fs_webdemo/register.cgi new file mode 100755 index 000000000..825582262 --- /dev/null +++ b/fs_webdemo/register.cgi @@ -0,0 +1,136 @@ +#!/usr/bin/perl -Tw +# +# $Id: register.cgi,v 1.5 2000-03-03 18:22:42 ivan Exp $ + +use strict; +use vars qw( + $datasrc $user $pass $x + $cgi $username $email + $dbh $sth + ); + #$freeside_bin $freeside_test $freeside_conf + #@pw_set @saltset + #$user_pw $crypt_pw + #$header $msg +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use DBI; +#use Mail::Internet; +#use Mail::Header; +#use Date::Format; + +$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +#$freeside_bin = '/home/freeside/bin/'; +#$freeside_test = '/home/freeside/test/'; +#$freeside_conf = '/usr/local/etc/freeside/'; + +$datasrc = 'DBI:mysql:http_auth'; +$user = "freeside"; +$pass = "maelcolm"; + +##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); +##my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' ); +#@pw_set = ( 'a'..'z', '0'..'9' ); +#@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +### + +$cgi = new CGI; + +$username = $cgi->param('username'); +$username =~ /^\s*([a-z][\w]{0,15})\s*$/i + or &idiot("Illegal username. Please use 1-16 alphanumeric characters, and start your username with a letter."); +$username = lc($1); + +$email = $cgi->param('email'); +$email =~ /^([\w\-\.\+]+\@[\w\-\.]+)$/ + or &idiot("Illegal email address."); +$email = $1; + +### + +#$user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); +#$crypt_pw = crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]); + +### + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + +### + +$dbh = DBI->connect( $datasrc, $user, $pass, { + 'AutoCommit' => 'true', +} ) or die "DBI->connect error: $DBI::errstr\n"; +$x = $DBI::errstr; #silly; to avoid "used only once" warning + +$sth = $dbh->prepare("INSERT INTO mysql_auth VALUES (". join(", ", + $dbh->quote($username), +# $dbh->quote("X"), +# $dbh->quote($crypt_pw), + $dbh->quote($email), + $dbh->quote('freeside'), + $dbh->quote('unconfigured'), +). ")" ); + +$sth->execute or &idiot("Username in use: ". $sth->errstr); + +$dbh->disconnect or die $dbh->errstr; + +### + +$|=1; +print $cgi->header; +print < + + Freeside demo registration successful + + + + +
+

+ Silicon Interactive Software Design +

+
freeside demo registration successful
+
+

Your sample database has been setup. Your password and the URL for the + Freeside demo have been emailed to you. + + +END + +### + +sub idiot { + my($error)=@_; + print $cgi->header, < + + Registration error + + +

+

Registration error

+
+

$error +

Hit the Back button in your web browser, correct this mistake, + and submit the form again. + + +END + + exit; + +} diff --git a/fs_webdemo/register.html b/fs_webdemo/register.html new file mode 100644 index 000000000..acf9cff7f --- /dev/null +++ b/fs_webdemo/register.html @@ -0,0 +1,33 @@ + + + + Freeside - Billing and account administration software for ISPs + + + + + +
+ + + + +
freeside demo registration
+
+

You will need to choose a username for access to the Freeside web demo. + +

A password + and the URL for your demo will be emailed to you, so don't waste your + time with non-deliverable addresses. +We will not give your email address to any third party, + nor will we send you any unsolicited email (or in fact any email after the automatic registration). +

+
+Freeside username: 
+
+Email address:     
+
+
+
+ + diff --git a/fs_webdemo/registerd b/fs_webdemo/registerd new file mode 100755 index 000000000..6314d0af2 --- /dev/null +++ b/fs_webdemo/registerd @@ -0,0 +1,192 @@ +#!/usr/bin/perl -w +# +# $Id: registerd,v 1.8 2000-03-03 12:27:54 ivan Exp $ + +use strict; +use vars qw( + $freeside_conf + $mysql_data + $datasrc $user $pass $x + $dbh $sth + @pw_set @saltset + $header $msg + ); + # $freeside_bin $freeside_test + # $cgi $username $name $email $user_pw $crypt_pw +#use CGI; +#use CGI::Carp qw(fatalsToBrowser); +use DBI; +use Mail::Internet; +use Mail::Header; +use Date::Format; + +#$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; +#$ENV{'SHELL'} = '/bin/sh'; +#$ENV{'IFS'} = " \t\n"; +#$ENV{'CDPATH'} = ''; +#$ENV{'ENV'} = ''; +#$ENV{'BASH_ENV'} = ''; + +#$freeside_bin = '/home/freeside/bin/'; +#$freeside_test = '/home/freeside/test/'; +$freeside_conf = '/usr/local/etc/freeside/'; + +$mysql_data = "/var/lib/mysql"; + +$datasrc = 'DBI:mysql:http_auth'; +$user = "freeside"; +$pass = "maelcolm"; + +#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); +#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' ); +@pw_set = ( 'a'..'z', '0'..'9' ); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +#die "not running as system user freeside" +# unless $> == scalar(getpwnam('freeside')); +die "not running as root user" + unless $> == 0; + +$dbh = DBI->connect( $datasrc, $user, $pass, { + 'AutoCommit' => 'true', +} ) or die "DBI->connect error: $DBI::errstr\n"; +$x = $DBI::errstr; #silly; to avoid "used only once" warning + +while ( 1 ) { + + $SIG{HUP} = 'IGNORE'; + $SIG{INT} = 'IGNORE'; + $SIG{QUIT} = 'IGNORE'; + $SIG{TERM} = 'IGNORE'; + $SIG{TSTP} = 'IGNORE'; + $SIG{PIPE} = 'IGNORE'; + + $sth = $dbh->prepare("LOCK TABLES mysql_auth WRITE"); + $sth->execute or die $sth->errstr; + + $sth = $dbh->prepare( + 'SELECT * FROM mysql_auth WHERE status = "unconfigured"' + ); + $sth->execute or die $sth->errstr; + my $pending = $sth->fetchall_arrayref( {} ); + + $sth = $dbh->prepare( + 'UPDATE mysql_auth SET status = "locked" WHERE status = "unconfigured"' + ); + $sth->execute or die $sth->errstr; + + $sth = $dbh->prepare("UNLOCK TABLES"); + $sth->execute or die $sth->errstr; + + # + + foreach my $row ( @{$pending} ) { + + my $username = $row->{'username'}; + my $email = $row->{'passwd'}; + + system("/usr/bin/mysqladmin --user=$user --password=$pass ". + "create demo_$username >/dev/null"); + + system "cp -p $mysql_data/demo_template/* $mysql_data/demo_$username"; + + mkdir "${freeside_conf}conf.DBI:mysql:demo_$username", 0755; + system "cp -pr ${freeside_conf}conf.DBI:mysql:demo_template/* ". + "${freeside_conf}conf.DBI:mysql:demo_$username"; + + mkdir "${freeside_conf}counters.DBI:mysql:demo_$username", 0755; + system "cp -p ${freeside_conf}counters.DBI:mysql:demo_template/* ". + "${freeside_conf}counters.DBI:mysql:demo_$username"; + chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')), + "${freeside_conf}counters.DBI:mysql:demo_$username"; + + system "cp -p ${freeside_conf}dbdef.DBI:mysql:demo_template ". + "${freeside_conf}dbdef.DBI:mysql:demo_$username"; + + open(INVOICE_FROM, ">${freeside_conf}conf.DBI:mysql:demo_$username/invoice_from") + or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/invoice_from: $!"; + print INVOICE_FROM "$email\n"; + close INVOICE_FROM; + + open(LPR, ">${freeside_conf}conf.DBI:mysql:demo_$username/lpr") + or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/lpr: $!"; + print LPR "mail $email"; + close LPR; + + open(FROM, ">${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/from") + or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/from: $!"; + print FROM "$email\n"; + close FROM; + + open(TO, ">${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/to") + or die "Can\'t open ${freeside_conf}conf.DBI:mysql:demo_$username/registries/internic/to: $!"; + print TO "$email\n"; + close TO; + + open(SECRETS, ">${freeside_conf}secrets.demo_$username") + or die "Can\'t open ${freeside_conf}secrets.demo_$username: $!"; + chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')), + "${freeside_conf}secrets.demo_$username"; + chmod 0600, "${freeside_conf}secrets.demo_$username"; + print SECRETS "DBI:mysql:demo_$username\nfreeside\nmaelcolm\n"; + close SECRETS; + + open(MAPSECRETS, ">>${freeside_conf}mapsecrets") + or die "Can\'t open ${freeside_conf}mapsecrets: $!"; + print MAPSECRETS "$username secrets.demo_$username\n"; + close MAPSECRETS; + + my $user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); + my $crypt_pw = + crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]); + + $sth = $dbh->prepare( + qq(UPDATE mysql_auth SET passwd = "$crypt_pw", status = "done" WHERE username = "$username") + ); + $sth->execute or die $sth->errstr; + + $ENV{SMTPHOSTS} = "localhost"; + $ENV{MAILADDRESS} = 'ivan-fsreg@sisd.com'; + $ENV{TZ} = "PST8PDT"; + $header = Mail::Header->new( [ + 'From: ivan-fsreg@sisd.com', + "To: $email", + 'Bcc: ivan-fsreg_bcc@sisd.com', + 'Sender: ivan-fsreg@sisd.com', + 'Reply-To: ivan-fsreg@sisd.com', + #'Date: '. time2str("%a, %d %b %Y %X %z", time ), + 'Date: '. time2str("%a, %d %b %Y %X ", time ). "-0800", + 'Subject: Freeside demo information', + ] ); + $msg = Mail::Internet->new( + 'Header' => $header, + 'Body' => [ + "Hello,\n", + "\n", + "Your sample Freeside database has been setup.\n", + "\n", + "Point your web browswer at http://freeside.sisd.com/ and use the following\n", + "authentication information:\n", + "\n", + "Username: $username\n", + "Password: $user_pw\n", + "\n", + "-- \n", + "ivan\n", + ] + ); + $msg->smtpsend or die "Can\'t send registration email!"; + + } + + $SIG{HUP} = 'DEFAULT'; + $SIG{INT} = 'DEFAULT'; + $SIG{QUIT} = 'DEFAULT'; + $SIG{TERM} = 'DEFAULT'; + $SIG{TSTP} = 'DEFAULT'; + $SIG{PIPE} = 'DEFAULT'; + + sleep 5; + +} + diff --git a/fs_webdemo/registerd.Pg b/fs_webdemo/registerd.Pg new file mode 100755 index 000000000..a4fd0552c --- /dev/null +++ b/fs_webdemo/registerd.Pg @@ -0,0 +1,196 @@ +#!/usr/bin/perl -w +# +# $Id: registerd.Pg,v 1.1 2001-04-23 12:40:30 ivan Exp $ + +use strict; +use vars qw( + $freeside_conf + $mysql_data + $datasrc $user $pass $x + $dbh $sth + @pw_set @saltset + $header $msg + ); + # $freeside_bin $freeside_test + # $cgi $username $name $email $user_pw $crypt_pw +#use CGI; +#use CGI::Carp qw(fatalsToBrowser); +use DBI; +use Mail::Internet; +use Mail::Header; +use Date::Format; + +#$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin'; +#$ENV{'SHELL'} = '/bin/sh'; +#$ENV{'IFS'} = " \t\n"; +#$ENV{'CDPATH'} = ''; +#$ENV{'ENV'} = ''; +#$ENV{'BASH_ENV'} = ''; + +#$freeside_bin = '/home/freeside/bin/'; +#$freeside_test = '/home/freeside/test/'; +$freeside_conf = '/usr/local/etc/freeside/'; + +#$mysql_data = "/var/lib/mysql"; + +$datasrc = 'DBI:mysql:http_auth'; +$user = "freeside"; +$pass = "maelcolm"; + +#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); +#my(@pw_set)= ( 'a'..'z', 'A'..'Z', '0'..'9' ); +@pw_set = ( 'a'..'z', '0'..'9' ); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +#die "not running as system user freeside" +# unless $> == scalar(getpwnam('freeside')); +die "not running as root user" + unless $> == 0; + +$dbh = DBI->connect( $datasrc, $user, $pass, { + 'AutoCommit' => 'true', +} ) or die "DBI->connect error: $DBI::errstr\n"; +$x = $DBI::errstr; #silly; to avoid "used only once" warning + +while ( 1 ) { + + $SIG{HUP} = 'IGNORE'; + $SIG{INT} = 'IGNORE'; + $SIG{QUIT} = 'IGNORE'; + $SIG{TERM} = 'IGNORE'; + $SIG{TSTP} = 'IGNORE'; + $SIG{PIPE} = 'IGNORE'; + + $sth = $dbh->prepare("LOCK TABLES mysql_auth WRITE"); + $sth->execute or die $sth->errstr; + + $sth = $dbh->prepare( + 'SELECT * FROM mysql_auth WHERE status = "unconfigured" OR status = "reconfigure"' + ); + $sth->execute or die $sth->errstr; + my $pending = $sth->fetchall_arrayref( {} ); + + $sth = $dbh->prepare( + 'UPDATE mysql_auth SET status = "locked" WHERE status = "unconfigured" OR status = "reconfigure"' + ); + $sth->execute or die $sth->errstr; + + $sth = $dbh->prepare("UNLOCK TABLES"); + $sth->execute or die $sth->errstr; + + # + + foreach my $row ( @{$pending} ) { + + my $username = $row->{'username'}; + my $email = $row->{'passwd'}; + my $status = $row->{'status'}; + + system("/usr/bin/createdb --username freeside demo_$username >/dev/null"); + + system "psql -U freeside demo_$username ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/invoice_from") + or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/invoice_from: $!"; + print INVOICE_FROM "$email\n"; + close INVOICE_FROM; + + open(LPR, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/lpr") + or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/lpr: $!"; + print LPR "mail $email"; + close LPR; + + open(FROM, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/from") + or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/from: $!"; + print FROM "$email\n"; + close FROM; + + open(TO, ">${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/to") + or die "Can\'t open ${freeside_conf}conf.DBI:Pg:host=localhost;dbname=demo_$username/registries/internic/to: $!"; + print TO "$email\n"; + close TO; + + open(SECRETS, ">${freeside_conf}secrets.demo_$username") + or die "Can\'t open ${freeside_conf}secrets.demo_$username: $!"; + chown scalar(getpwnam('freeside')), scalar(getgrnam('freeside')), + "${freeside_conf}secrets.demo_$username"; + chmod 0600, "${freeside_conf}secrets.demo_$username"; + print SECRETS "DBI:Pg:host=localhost;dbname=demo_$username\nfreeside\nmaelcolm\n"; + close SECRETS; + + open(MAPSECRETS, ">>${freeside_conf}mapsecrets") + or die "Can\'t open ${freeside_conf}mapsecrets: $!"; + print MAPSECRETS "$username secrets.demo_$username\n"; + close MAPSECRETS; + + my $user_pw = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); + my $crypt_pw = + crypt($user_pw,$saltset[int(rand(64))].$saltset[int(rand(64))]); + + $sth = $dbh->prepare( + qq(UPDATE mysql_auth SET passwd = "$crypt_pw", status = "done" WHERE username = "$username") + ); + $sth->execute or die $sth->errstr; + + if ( $status eq "unconfigured" ) { + + #$ENV{SMTPHOSTS} = "localhost"; + $ENV{SMTPHOSTS} = "192.168.1.1"; + $ENV{MAILADDRESS} = 'ivan-fsreg@sisd.com'; + $ENV{TZ} = "PST8PDT"; + $header = Mail::Header->new( [ + 'From: ivan-fsreg@sisd.com', + "To: $email", + 'Bcc: ivan-fsreg_bcc@sisd.com', + 'Sender: ivan-fsreg@sisd.com', + 'Reply-To: ivan-fsreg@sisd.com', + #'Date: '. time2str("%a, %d %b %Y %X %z", time ), + 'Date: '. time2str("%a, %d %b %Y %X ", time ). "-0800", + 'Subject: Freeside demo information', + ] ); + $msg = Mail::Internet->new( + 'Header' => $header, + 'Body' => [ + "Hello,\n", + "\n", + "Your sample Freeside database has been setup.\n", + "\n", + "Point your web browswer at http://freeside.sisd.com/ and use the following\n", + "authentication information:\n", + "\n", + "Username: $username\n", + "Password: $user_pw\n", + "\n", + "-- \n", + "ivan\n", + ] + ); + $msg->smtpsend or die "Can\'t send registration email!"; + } + + } + + $SIG{HUP} = 'DEFAULT'; + $SIG{INT} = 'DEFAULT'; + $SIG{QUIT} = 'DEFAULT'; + $SIG{TERM} = 'DEFAULT'; + $SIG{TSTP} = 'DEFAULT'; + $SIG{PIPE} = 'DEFAULT'; + + sleep 5; + +} + diff --git a/htdocs/.htaccess b/htdocs/.htaccess new file mode 100644 index 000000000..f8c6b9c0c --- /dev/null +++ b/htdocs/.htaccess @@ -0,0 +1,3 @@ +AuthName Freeside +AuthType Basic +require valid-user diff --git a/htdocs/browse/agent.cgi b/htdocs/browse/agent.cgi index cf5f2281f..b73d17b76 100755 --- a/htdocs/browse/agent.cgi +++ b/htdocs/browse/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: browse agent +# $Id: agent.cgi,v 1.13 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -13,36 +13,93 @@ # agent type was linking to wrong cgi ivan@sisd.com 98-jul-18 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent.cgi,v $ +# Revision 1.13 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.12 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.11 1999/01/20 09:43:16 ivan +# comment out future UI code (but look at it, it's neat!) +# +# Revision 1.10 1999/01/19 05:13:24 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.9 1999/01/18 09:41:14 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.8 1999/01/18 09:22:26 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.7 1998/12/17 05:25:16 ivan +# fix visual and other bugs +# +# Revision 1.6 1998/11/23 05:29:46 ivan +# use CGI::Carp +# +# Revision 1.5 1998/11/23 05:27:31 ivan +# to eliminate warnings +# +# Revision 1.4 1998/11/20 08:50:36 ivan +# s/CGI::Base/CGI.pm, visual fixes +# +# Revision 1.3 1998/11/08 10:11:02 ivan +# CGI.pm +# +# Revision 1.2 1998/11/07 10:24:22 ivan +# don't use depriciated FS::Bill and FS::Invoice, other miscellania +# use strict; -use CGI::Base; +use vars qw( $ui $cgi $p $agent ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar table popurl); +use FS::agent; +use FS::agent_type; + +#Begin silliness +# +#use FS::UI::CGI; +#use FS::UI::agent; +# +#$ui = new FS::UI::agent; +#$ui->browse; +#exit; +#__END__ +#End silliness -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header('Agent Listing', menubar( - 'Main Menu' => '../', - 'Add new agent' => '../edit/agent.cgi' +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('Agent Listing', menubar( + 'Main Menu' => $p, + 'Agent Types' => $p. 'browse/agent_type.cgi', +# 'Add new agent' => '../edit/agent.cgi' )), < - Click on agent number to edit. - +Agents are resellers of your service. Agents may be limited to a subset of your +full offerings (via their type).

+END +print &table(), < - - + END +# +# -my($agent); foreach $agent ( sort { $a->getfield('agentnum') <=> $b->getfield('agentnum') } qsearch('agent',{}) ) { @@ -52,10 +109,11 @@ foreach $agent ( sort { my($atype)=$agent_type->getfield('atype'); print < - - - + + @@ -64,8 +122,12 @@ END } print < + + +
Agent #AgentAgent Type Freq. (unimp.) Prog. (unimp.)
Agent #Agent + $hashref->{agentnum}$hashref->{agent}$atype + $hashref->{agent}$atype $hashref->{freq} $hashref->{prog}
Add new agentAdd new agent type
- + END diff --git a/htdocs/browse/agent_type.cgi b/htdocs/browse/agent_type.cgi index 5f05bd514..9d8687299 100755 --- a/htdocs/browse/agent_type.cgi +++ b/htdocs/browse/agent_type.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent_type.cgi: browse agent_type +# $Id: agent_type.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-10 # @@ -9,34 +9,58 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent_type.cgi,v $ +# Revision 1.8 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.7 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.6 1999/04/07 11:10:46 ivan +# harmless typo +# +# Revision 1.5 1999/01/19 05:13:25 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:15 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 05:25:17 ivan +# fix visual and other bugs +# +# Revision 1.2 1998/11/21 07:39:52 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $p $agent_type ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::agent_type; +use FS::type_pkgs; +use FS::part_pkg; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -print header("Agent Type Listing", menubar( - 'Main Menu' => '../', - 'Add new agent type' => "../edit/agent_type.cgi", -)), <Click on agent type number to edit. - +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("Agent Type Listing", menubar( + 'Main Menu' => $p, +)), "Agent types define groups of packages that you can then assign to". + " particular agents.

", &table(), < - - - + + END -my($agent_type); foreach $agent_type ( sort { $a->getfield('typenum') <=> $b->getfield('typenum') } qsearch('agent_type',{}) ) { @@ -46,10 +70,10 @@ foreach $agent_type ( sort { $rowspan = int($rowspan/2+0.5) ; print < - - + END my($type_pkgs); @@ -59,7 +83,7 @@ END my($part_pkg) = qsearchs('part_pkg',{'pkgpart'=> $pkgpart }); print qq!! if ($tdcount == 0) ; $tdcount = 0 if ($tdcount == -1) ; - print qq!"; $tdcount ++ ; if ($tdcount == 2) @@ -73,8 +97,8 @@ END } print <
Type #TypePackagesAgent TypePackages
+ $hashref->{typenum} $hashref->{atype}$hashref->{atype}
!, + print qq!!, $part_pkg->getfield('pkg'),"
- + Add new agent type + END diff --git a/htdocs/browse/cust_main_county.cgi b/htdocs/browse/cust_main_county.cgi index d615198c9..5f2b13dc0 100755 --- a/htdocs/browse/cust_main_county.cgi +++ b/htdocs/browse/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county.cgi: browse cust_main_county +# $Id: cust_main_county.cgi,v 1.7 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-13 # @@ -8,46 +8,85 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.7 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.6 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.5 1999/01/19 05:13:26 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:16 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 05:25:18 ivan +# fix visual and other bugs +# +# Revision 1.2 1998/11/18 09:01:34 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $p $cust_main_county ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header("Tax Rate Listing", menubar( - 'Main Menu' => '../', - 'Edit tax rates' => "../edit/cust_main_county.cgi", +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("Tax Rate Listing", menubar( + 'Main Menu' => $p, + 'Edit tax rates' => $p. "edit/cust_main_county.cgi", )),<Click on expand to specify tax rates by county. -

+ Click on expand country to specify a country's tax rates by state. +
Click on expand state to specify a state's tax rates by county. +

+END +print &table(), < + END -my($cust_main_county); foreach $cust_main_county ( qsearch('cust_main_county',{}) ) { my($hashref)=$cust_main_county->hashref; print < - + END - - print ""; + print ""; print <$hashref->{tax}% diff --git a/htdocs/browse/nas.cgi b/htdocs/browse/nas.cgi new file mode 100755 index 000000000..a65235b1e --- /dev/null +++ b/htdocs/browse/nas.cgi @@ -0,0 +1,94 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw( $cgi $p ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use Date::Format; +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearch); # qsearchs); +use FS::CGI qw(header menubar table popurl); +use FS::nas; +use FS::port; +use FS::session; + +$cgi = new CGI; +&cgisuidsetup($cgi); + +$p=popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('NAS ports', menubar( + 'Main Menu' => $p, +)); + +my $now = time; + +foreach my $nas ( sort { $a->nasnum <=> $b->nasnum } qsearch( 'nas', {} ) ) { + print $nas->nasnum. ": ". $nas->nas. " ". + $nas->nasfqdn. " (". $nas->nasip. ") ". + "as of ". time2str("%c",$nas->last). + " (". &pretty_interval($now - $nas->last). " ago)
". + &table(). "
". + "", + ; + foreach my $port ( sort { + $a->nasport <=> $b->nasport || $a->portnum <=> $b->portnum + } qsearch( 'port', { 'nasnum' => $nas->nasnum } ) ) { + my $session = $port->session; + my($user, $since, $pretty_since, $duration); + if ( ! $session ) { + $user = "(empty)"; + $since = 0; + $pretty_since = "(never)"; + $duration = ''; + } elsif ( $session->logout ) { + $user = "(empty)"; + $since = $session->logout; + } else { + my $svc_acct = $session->svc_acct; + $user = "svcnum. "\">". + $svc_acct->username. ""; + $since = $session->login; + } + $pretty_since = time2str("%c", $since) if $since; + $duration = pretty_interval( $now - $since ). " ago" + unless defined($duration); + print "" + ; + } + print "
Country State County Tax
$hashref->{state}$hashref->{country}", $hashref->{county} - ? $hashref->{county} + print "", $hashref->{state} + ? $hashref->{state} : qq!(ALL) !. - qq!expand! + qq!expand country! , ""; + if ( $hashref->{county} ) { + print $hashref->{county}; + } else { + print "(ALL)"; + if ( $hashref->{state} ) { + print qq!!. + qq!expand state!; + } + } + print "
Nas
Port #
Global
Port #
IP addressUserSinceDuration
". $port->nasport. "". $port->portnum. "". + $port->ip. "$user$pretty_since". + "$duration

"; +} + +sub pretty_interval { + my $interval = shift; + my %howlong = ( + '604800' => 'week', + '86400' => 'day', + '3600' => 'hour', + '60' => 'minute', + '1' => 'second', + ); + + my $pretty = ""; + foreach my $key ( sort { $b <=> $a } keys %howlong ) { + my $value = int( $interval / $key ); + if ( $value ) { + if ( $value == 1 ) { + $pretty .= + ( $howlong{$key} eq 'hour' ? 'an ' : 'a ' ). $howlong{$key}. " " + } else { + $pretty .= $value. ' '. $howlong{$key}. 's '; + } + } + $interval -= $value * $key; + } + $pretty =~ /^\s*(\S.*\S)\s*$/; + $1; +} + +#print &table(), < +# # +# NASheader calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/17 05:25:19 ivan +# fix visual and other bugs +# +# Revision 1.3 1998/11/21 07:23:45 ivan +# visual +# +# Revision 1.2 1998/11/21 07:00:32 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $p $part_pkg ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::part_pkg; +use FS::pkg_svc; +use FS::part_svc; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +$p = popurl(2); -print header("Package Part Listing",menubar( - 'Main Menu' => '../', - 'Add new package' => "../edit/part_pkg.cgi", -)), <Click on package part number to edit. +print $cgi->header( '-expires' => 'now' ), header("Package Part Listing",menubar( + 'Main Menu' => $p, +)), "One or more services are grouped together into a package and given", + " pricing information. Customers purchase packages, not services.

", + &table(), < - Part # - Package + Package Comment Setup Fee Freq. @@ -40,7 +68,6 @@ print header("Package Part Listing",menubar( END -my($part_pkg); foreach $part_pkg ( sort { $a->getfield('pkgpart') <=> $b->getfield('pkgpart') } qsearch('part_pkg',{}) ) { @@ -50,10 +77,10 @@ foreach $part_pkg ( sort { my($rowspan)=scalar(@pkg_svc); print < - + $hashref->{pkgpart} - $hashref->{pkg} + $hashref->{pkg} $hashref->{comment} $hashref->{setup} $hashref->{freq} @@ -61,20 +88,22 @@ foreach $part_pkg ( sort { END my($pkg_svc); + my($n)=""; foreach $pkg_svc ( @pkg_svc ) { my($svcpart)=$pkg_svc->getfield('svcpart'); my($part_svc) = qsearchs('part_svc',{'svcpart'=> $svcpart }); - print qq!!, + print $n,qq!!, $part_svc->getfield('svc'),"", - $pkg_svc->getfield('quantity'),"\n"; + $pkg_svc->getfield('quantity'),"\n"; + $n=""; } print ""; } print < - + Add new package + END diff --git a/htdocs/browse/part_referral.cgi b/htdocs/browse/part_referral.cgi index b16fa896d..e4ca25a65 100755 --- a/htdocs/browse/part_referral.cgi +++ b/htdocs/browse/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_referral.cgi: Browse part_referral +# $Id: part_referral.cgi,v 1.9 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -8,47 +8,78 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# Revision 1.9 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.8 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.7 1999/01/19 05:13:28 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:18 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/17 05:25:20 ivan +# fix visual and other bugs +# +# Revision 1.4 1998/12/17 04:32:55 ivan +# print $cgi->header +# +# Revision 1.3 1998/12/17 04:31:36 ivan +# use CGI::Carp +# +# Revision 1.2 1998/12/17 04:26:04 ivan +# use CGI; no relative URLs +# use strict; -use CGI::Base; +use vars qw( $cgi $p $part_referral ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::part_referral; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header("Referral Listing", menubar( - 'Main Menu' => '../', - 'Add new referral' => "../edit/part_referral.cgi", -)), <Click on referral number to edit. - +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("Referral Listing", menubar( + 'Main Menu' => $p, +# 'Add new referral' => "../edit/part_referral.cgi", +)), "Where a customer heard about your service. Tracked for informational purposes.

", &table(), < - - + END -my($part_referral); foreach $part_referral ( sort { $a->getfield('refnum') <=> $b->getfield('refnum') } qsearch('part_referral',{}) ) { my($hashref)=$part_referral->hashref; print < - - + END } print < + +
Referral #ReferralReferral
+ $hashref->{refnum}$hashref->{referral} + $hashref->{referral}
Add new referral
diff --git a/htdocs/browse/part_svc.cgi b/htdocs/browse/part_svc.cgi index 71a556421..123cb7d2a 100755 --- a/htdocs/browse/part_svc.cgi +++ b/htdocs/browse/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_svc.cgi: browse part_svc +# $Id: part_svc.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-nov-14, 97-dec-9 # @@ -8,37 +8,70 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_svc.cgi,v $ +# Revision 1.11 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.10 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.9 1999/01/19 05:13:29 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.8 1999/01/18 09:41:19 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.7 1998/12/30 23:06:22 ivan +# typo +# +# Revision 1.6 1998/12/30 23:03:20 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.5 1998/12/17 05:25:21 ivan +# fix visual and other bugs +# +# Revision 1.4 1998/11/21 02:26:22 ivan +# visual +# +# Revision 1.3 1998/11/20 23:10:57 ivan +# visual +# +# Revision 1.2 1998/11/20 08:50:37 ivan +# s/CGI::Base/CGI.pm, visual fixes +# use strict; -use CGI::Base; -use FS::UID qw(cgisuidsetup swapuid); -use FS::Record qw(qsearch); -use FS::part_svc qw(fields); -use FS::CGI qw(header menubar); +use vars qw( $cgi $p $part_svc ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearch fields); +use FS::part_svc; +use FS::CGI qw(header menubar popurl table); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header('Service Part Listing', menubar( - 'Main Menu' => '../', - 'Add new service' => "../edit/part_svc.cgi", +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('Service Part Listing', menubar( + 'Main Menu' => $p, )),<Click on service part number to edit. - + Services are items you offer to your customers.

+END +print &table(), < - - + - - + END -my($part_svc); foreach $part_svc ( sort { $a->getfield('svcpart') <=> $b->getfield('svcpart') } qsearch('part_svc',{}) ) { @@ -51,30 +84,34 @@ foreach $part_svc ( sort { grep /^${svcdb}__/, fields('part_svc') ; - my($rowspan)=scalar(@rows); + my($rowspan)=scalar(@rows) || 1; print < - - + + END + + my($n1)=''; my($row); foreach $row ( @rows ) { my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag'); - print ""; + print ""; + $n1=""; } print ""; } print < + +
Part #ServiceService Table FieldActionValueModifier
- $hashref->{svcpart} - $hashref->{svc} + $hashref->{svcpart} $hashref->{svc} $hashref->{svcdb}$row"; + print $n1,"$row"; if ( $flag eq "D" ) { print "Default"; } elsif ( $flag eq "F" ) { print "Fixed"; } else { print "(Unknown!)"; } - print "",$part_svc->getfield($svcdb."__".$row),"
",$part_svc->getfield($svcdb."__".$row),"
Add new service
- END diff --git a/htdocs/browse/svc_acct_pop.cgi b/htdocs/browse/svc_acct_pop.cgi index a8a3a9224..8094a9fd1 100755 --- a/htdocs/browse/svc_acct_pop.cgi +++ b/htdocs/browse/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct_pop.cgi: browse pops +# $Id: svc_acct_pop.cgi,v 1.8 2000-01-28 22:56:13 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,53 +8,87 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.8 2000-01-28 22:56:13 ivan +# track full phone number +# +# Revision 1.7 1999/04/09 04:22:34 ivan +# also table() +# +# Revision 1.6 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.5 1999/01/19 05:13:30 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:20 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 05:25:22 ivan +# fix visual and other bugs +# +# Revision 1.2 1998/12/17 04:36:59 ivan +# use CGI;, use CGI::Carp, visual changes, relative URLs +# use strict; -use CGI::Base; +use vars qw( $cgi $p $svc_acct_pop ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup swapuid); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar table popurl); +use FS::svc_acct_pop; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. -print header('POP Listing', menubar( - 'Main Menu' => '../', - 'Add new POP' => "../edit/svc_acct_pop.cgi", -)), <Click on pop number to edit. - +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header('POP Listing', menubar( + 'Main Menu' => $p, +)), "Points of Presence

", &table(), < - + + 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 } print < + +
POP # City State Area code ExchangeLocal
+ $hashref->{popnum}$hashref->{city}$hashref->{state}$hashref->{ac}$hashref->{exch} + $hashref->{city} + $hashref->{state} + $hashref->{ac} + $hashref->{exch} + $hashref->{loc}
Add new POP
diff --git a/htdocs/docs/CGI-modules-2.76-patch.txt b/htdocs/docs/CGI-modules-2.76-patch.txt deleted file mode 100755 index 55b50bbbe..000000000 --- a/htdocs/docs/CGI-modules-2.76-patch.txt +++ /dev/null @@ -1,23 +0,0 @@ -ivan@rootwood:~/src/CGI-modules-2.76/CGI$ diff -c Base.pm Base.pm.orig -*** Base.pm Sat Jul 18 00:33:21 1998 ---- Base.pm.orig Sat Jul 18 00:06:12 1998 -*************** -*** 938,945 **** - my $orig_uri = $self->get_uri; - $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri") - if $Debug; -! my $msg = ($perm) ? StatusHdr(301,"Moved Permanently") -! : StatusHdr(302,"Moved Temporarily"); - my $hdrs = SendHeaders($msg, LocationHdr($to_uri)); - $self->log($hdrs); - } ---- 938,945 ---- - my $orig_uri = $self->get_uri; - $self->log("Redirecting $CGI::Base::REQUEST_METHOD $orig_uri to $to_uri") - if $Debug; -! my $msg = ($perm) ? ServerHdr(301,"Moved Permanently") -! : ServerHdr(302,"Moved Temporarily"); - my $hdrs = SendHeaders($msg, LocationHdr($to_uri)); - $self->log($hdrs); - } - diff --git a/htdocs/docs/admin.html b/htdocs/docs/admin.html index 8adddbe92..b6665e05e 100644 --- a/htdocs/docs/admin.html +++ b/htdocs/docs/admin.html @@ -4,3 +4,56 @@

Administration

+
    +
  • Open up the root of the Freeside document tree in your web + browser. For example, if you created the Freeside document tree in + /home/httpd/html/freeside, and your web browser's DocumentRoot is + /home/httpd/html, open http://your_host/freeside/. Replace + "your_host" with the name or network address of your web server. + +
  • Once in the Freeside web interface, you must first create a + service. An example of a service would be a dial-up account or a + hosted virtual domain. + +
  • After you create your first service or services, you must then + create a package of that service or services which you will sell to + your customer. To allow flexibility in changing your service + offerings, Freeside requires that you bundle your services into a + package before customers may purchase them. For instance, you could + create a leased line package which would consist of a one-time + charge for the customer premise equipment, the monthly service fee + for the leased line, a backup dial-up account, and a support + contract. You could also create a leased line package which omits + the support contract simply by adding a new package that does not + include the support contract. + +
  • After you create your first package, then you must define who is + able to sell that package by creating an agent type. An example of + an agent type would be an internal sales representitive which sells + regular and promotional packages, as opposed to an external sales + representitive which would only sell regular packages of services. + +
  • After creating a new agent type, you must create an agent, and + assign the the agent type you just created to it. + +
  • If the service you created was of type svc_acct, you may have to + create a POP from the main menu before you can create your first new + customer. + +
  • If you are using Freeside to keep track of sales taxes, you must + define tax information for your locale by clicking on the "View/Edit + locales and tax rates" link on the Freeside main menu. + +
  • Finally, you may optionally set up a referral by clicking on the + "View/Edit referrals" link in the Freeside main menu. Referrals + will help you keep track of how effective your advertising is, by + helping you keep track of where customers heard of your service + offerings. You must create at least one referral. If you do not wish to + use the referral functionality, simply create a single referral only. + +
  • You should now be ready to sign up your first customer by + clicking on the "New Customer" link at the top of the Freeside main + menu. +
+ + diff --git a/htdocs/docs/billing.html b/htdocs/docs/billing.html index 02bfbd783..7841bf776 100644 --- a/htdocs/docs/billing.html +++ b/htdocs/docs/billing.html @@ -3,19 +3,37 @@

Billing

- The bin/bill script can be run daily to bill all customers. Usage: bill [ -c [ i ] ] [ -d date ] [ -b ]
    -
  • -c: Turn on collecting (you probably want this). -
  • -i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards. Not available without modifying site_perl/Bill.pm -
  • -d: Pretend it is date (parsed by Date::Parse) -
  • -b: N/A -
- Printing should be configured on your freeside machine to print invoices. -

Batch credit card processing -
    -
  • After this script is run, a credit card batch will be in the cust_pay_batch table. Export this table to your credit card batching. -
  • When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the cust_pay table. Example code to add payments is: -
    use FS::cust_pay;
    +    
  • To enable billing, you must create an invoice_template configuration file. An example file is available in the conf/ directory of the distribution. You also need to create an lpr configuration file to enable postal invoices. +
      +
    • Optional: Invoice template customization +
        +
      • See the Text::Template documentation for details on the substitution language. +
      • You must call the invoice_lines() function at least once - pass it a number of lines, and it returns a list of array references, each of two elements: a service description column, and a price column. +
      • In addition, the following variables are available: +
          +
        • $invnum - invoice number +
        • $date - as a UNIX timestamp (see Date::Format for conversion functions). +
        • $page - current page +
        • $total_pages - total pages +
        • @address - A six-element array containing the customer name, company, and address. +
        • $overdue - true if this invoice is overdue +
        +
      +
    +
  • You can bill individual customers by clicking on the Bill now link on the main customer view. +
  • The freeside-bill script can be run daily to bill all customers. Usage:
    bill [ -c [ i ] ] [ -d date ] [ -b ] user
    +
      +
    • -c: Turn on collecting (you probably want this). +
    • -i: Real-time billing (as opposed to bacth billing). Only relevant for credit cards. +
    • -d: Pretend it is date (parsed by Date::Parse) +
    • -b: N/A +
    +

    Batch credit card processing +
      +
    • After this script is run, a credit card batch will be in the cust_pay_batch table. Export this table to your credit card batching. +
    • When your batch completes, erase the cust_pay_batch records in that batch and add any necessary paymants to the cust_pay table. Example code to add payments is: +
      use FS::cust_pay;
       
       # loop over all records in batch
       
      @@ -35,6 +53,15 @@ if ( $error ) {
       
       # end loop
       
      -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. +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.

      +
    • The freeside-print-batch script can print or email pending credit card batches for manual entry. Usage: freeside-print-batch [-v] [-p] [-e] [-a] [-d] user +
        +
      • -v: Verbose - Prints records to STDOUT. +
      • -p: Print to printer lpr as found in the conf directory. +
      • -e: Email output to user found in the Conf email file. +
      • -a: Automatically pays all records in cust_pay_batch. Use -d with this option usually. +
      • -d: Delete - Pays account and deletes record from cust_pay_batch. +
      +
diff --git a/htdocs/docs/config.html b/htdocs/docs/config.html index 9b8002601..b255ce30e 100644 --- a/htdocs/docs/config.html +++ b/htdocs/docs/config.html @@ -3,20 +3,69 @@

Configuration files

-Configuration files and directories are located in `/var/spool/freeside/conf'.
    -
  • address - Your company name and address, four lines. -
  • bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'. -
  • cybercash2 - CyberCash v2 support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required. +
  • Create the /usr/local/etc/freeside directory to hold your configuration. +
  • Setting up Apache user authetication is mandatory. +
  • Create the /usr/local/etc/freeside/mapsecrets file, which maps Apache users to a secrets file which contains a DBI data source, username and password. Every +line in /usr/local/etc/freeside/mapsecrets should contain a username and +filename, separated by whitespace. Note that these are not local usernames - +they are passed from Apache. +Apache user authetication is mandatory. For example, if you had the Apache users admin, +john, and sam, +you mapsecrets file might look like: +
    +admin secretfile
    +john secretfile
    +sam secretfile
    +
    +
  • Next, the filename(s) referenced in /usr/local/etc/freeside/mapsecrets file should be created in the /usr/local/etc/freeside/ directory. Each file contains three lines: DBI data source (for example, + DBI:mysql:freeside or DBI:Pg:host=localhost;dbname=freeside), database username, and database password. + These files should not be world readable. See the DBI manpage and the manpage for your DBD for the exact syntax of a DBI data source. In a normal installation such as the example above, a single file /usr/local/etc/freeside/secretfile would be created - for example: +
    +DBI:Pg:host=localhost;dbname=freeside
    +dbusername
    +dbpassword
    +
    +
+All further configuration files and directories are located in +/usr/local/etc/freeside/conf.datasource, for example, +/usr/local/etc/freeside/conf.DBI:Pg:host=localhost;dbname=freeside (remember to backslash-escape the ; character when creating directories in the shell: mkdir /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=freeside). +
    +
  • address - This configuration file is no longer used. See invoice_template instead. +
  • apacheroot - The directory containing Apache virtual hosts +
  • apachemachine - A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home' configuration file, symlinks into user home directories. +
  • apachemachines - Your Apache machines, one per line. This enables export of `/etc/apache/vhosts.conf', which can be included in your Apache configuration via the Include directive. +
  • autocapnames - The presence of this file will cause Freeside to use Javascript in /htdocs/edit/cust_main.cgi to automatically capitalize the first and last names of customers. +
  • bindprimary - Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named +
  • bindsecondaries - Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf +
  • bsdshellmachines - Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/master.passwd'. +
  • countrydefault - Default two-letter country code (if not supplied, the default is `US') +
  • cybercash2 - CyberCash v2 support, four lines: paymentserverhost, paymentserverport, paymentserversecret, and transaction type (`mauthonly' or `mauthcapture'). CCLib.pm is required.
  • cybercash3.2 - CyberCash v3.2 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. -
  • domain - Your domain name. -
  • erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'. -
  • home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash. -
  • lpr - Print command for paper invoices, for example `lpr -h'. -
  • nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'. -
  • 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'. -
  • radiusmachines - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'. -
  • registries - Directory which contains domain registry information. Each registry is a directory. +
  • deletecustomers - The existance of this file will enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers' packages if they cancel service. +
  • domain - Your domain name. +
  • editreferrals - The existance of this file will allow you to change the referral of existing customers. +
  • erpcdmachines - Your ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd' and `/usr/annex/acp_dialup'. +
  • hidecancelledpackages - The existance of this file will prevent cancelled packages from showing up in listings (though they will still be in the database) +
  • hidecancelledcustomers - The existance of this file will prevent customers with only cancelled packages from showing up in listings (though they will still be in the database) +
  • home - For new users, prefixed to usrename to create a directory name. Should have a leading but not a trailing slash. +
  • icradiusmachines - Your ICRADIUS machines, one per line. The existance of this file (even if empty) turns on radcheck table creation (in the freeside database - the radcheck table needs to be created manually). Machines listed in this file will have the radcheck table exported to them. Each line of this file should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: "radius.isp.tld radius_db radius_user passw0rd". Note that to use ICRADIUS export you need to be using MySQL. +
  • icradius_mysqldest - Destination directory for the MySQL databases, on the ICRADIUS machines. Defaults to "/usr/local/var/". +
  • icradius_mysqlsource - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside". +
  • icradius_secrets - Optionally specifies a MySQL database for ICRADIUS export, if you're not running MySQL for your Freeside database. The database should be on the Freeside machine and store data in the icradius_mysqlsource directory. Three lines: DBI data source, username and password. This file should not be world readable. +
  • invoice_from - Return address on email invoices. +
  • invoice_template - Required template file for invoices. See the section on billing for details. +
  • lpr - Print command for paper invoices, for example `lpr -h'. +
  • maildisablecatchall - The existance of this file will disable the requirement that each virtual domain have a catch-all mailbox. +
  • money_char - Currency symbol - defaults to `$'. +
  • mxmachines - MX entries for new domains, weight and machine, one per line, with trailing `.' +
  • nsmachines - NS nameservers for new domains, one per line, with trailing `.' +
  • nismachines - Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd' and `/etc/global/shadow'. +
  • passwordmin - Minimum password length (default 6); +
  • 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'. +
  • radiusmachines - Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users'. +
  • referraldefault - Default referral, specified by refnum. +
  • registries - Directory which contains domain registry information. Each registry is a directory.
    • registries/internic - Currently the only supported registry
        @@ -27,12 +76,29 @@ Configuration files and directories are located in `/var/spool/freeside/conf'.
      • registries/internic/to - Email address to which InterNIC domain registrations are sent.
    -
  • 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. -
  • sendmailmachines - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'. -
  • 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. -
  • shellmachines - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files. -
  • 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. -
  • smtpmachine - SMTP relay for Freeside's outgoing mail. +
  • sendmailconfigpath - Sendmail configuration file path - defaults to `/etc'. Many newer distributions use `/etc/mail'. +
  • sendmailmachines - Your sendmail machines, one per line. This enables export of `/etc/virtusertable' and `/etc/sendmail.cw'. +
  • sendmailrestart - If defined, the command which is run on sendmail machines after files are copied. +
  • session-start - If defined, the command which is executed on the Freeside machine when a session begins. The contents of the file are treated as a double-quoted perl string, with the following variables available: $ip, $nasip and $nasfqdn, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on. +
  • session-stop - If defined, the command which is executed on the Freeside machine when a session ends. The contents of the file are treated as a double-quoted perl string, with the following variables available: $ip, $nasip and $nasfqdn, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on. +
  • 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. +
  • shellmachine-useradd - The command(s) to run on shellmachine when an account is created. If this file does not exist, useradd -d $dir -m -s $shell -u $uid $username is the default. If the file exists but is empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell. +
  • shellmachine-userdel - The command(s) to run on shellmachine when an account is deleted. If this file does not exist, userdel $username is the default. If the file exists but is empty, rm -rf $dir is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $username and $dir. +
  • shellmachine-usermod - The command(s) to run on shellmachine when an account is modified. If this file does not exist or is empty, [ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir ) is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $old_dir, $new_dir, $uid and $gid. +
  • shellmachines - Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd' and `/etc/shadow' files. +
  • 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. +
  • showpasswords - The existance of this file will allow unencrypted user passwords to be displayed. +
  • smtpmachine - SMTP relay for Freeside's outgoing mail. +
  • soadefaultttl - SOA default TTL for new domains. +
  • soaemail - SOA email for new domains, in BIND form (`.' instead of `@'), with trailing `.' +
  • soaexpire - SOA expire for new domains +
  • soamachine - SOA machine for new domains, with trailing `.' +
  • soarefresh - SOA refresh for new domains +
  • soaretry - SOA retry for new domains +
  • statedefault - Default state or province (if not supplied, the default is `CA') +
  • textradiusprepend - The contents of this file will be prepended to the first line of a user's RADIUS entry in text exports. If necessary, usually `Auth-Type = Local, '. +
  • usernamemin - Minimum username length (default 2); +
  • usernamemax - Maximum username length (default is the size of the SQL column, probably specified when fs-setup was run)
diff --git a/htdocs/docs/export.html b/htdocs/docs/export.html index f760b97dd..d92eec346 100644 --- a/htdocs/docs/export.html +++ b/htdocs/docs/export.html @@ -4,29 +4,31 @@

File exporting

    -
  • 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 configuration files, you can export these files to your remote machines unattended; see below. +
  • 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 /usr/local/etc/freeside/export.datasrc directory. Some RADIUS servers (such as Radiator and ICRADIUS) will authenticate directly out of an SQL database. In these cases, +it is reccommended that you replicate the data to an external RADIUS machine rather than running the RADIUS server on your Freeside machine. Using the appropriate configuration files, you can export these files to your remote machines unattended:
      -
    • 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. -
    • 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. -
    • 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. -
    • 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. -
    • 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. +
    • shellmachines - passwd and shadow are copied to the remote machine as /etc/passwd.new and /etc/shadow.new and then moved to /etc/passwd and /etc/shadow if no errors occur. +
    • 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. +
    • 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. +
    • 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. +
    • 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. +
    • icradiusmachines - Local radcheck and radreply tables will be created. If any machines are specified, the remote MySQL database will be locked and the radcheck table will be copied to the those machines. You may also need to set the icradius_mysqlsource and/or icradius_mysqldest configuration files. Currently you need to be running MySQL for your Freeside database to use this feature.
  • site_perl/svc_acct.pm - If a shellmachine is defined, users can be created, modified and deleted remotely; see below.
      -
    • The command `useradd -d homedir -s shell -u uid username' is executed when a user is added. -
    • The command `userdel username' is executed with a user is deleted. -
    • If a user's home directory changes, the command `[ -d old_homedir && ( chmod u+t old_homedir; umask 022; mkdir new_homedir; cd old_homedir; find . -depth -print | cpio -pdm new_homedir; chmod u-t new_homedir; chown -R uid.gid new_homedir; rm -rf old_homedir )' is executed. +
    • Account creation - If the username, uid and dir fields are defined for a new user, the command(s) specified in the shellmachine-useradd configuration file are executed on shellmachine via ssh. If this file does not exist, useradd -d $dir -m -s $shell -u $uid $username is the default. If the file exists but is empty, cp -pr /etc/skel $dir; chown -R $uid.$gid $dir is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $username, $uid, $gid, $dir, and $shell. +
    • Account deletion - The command(s) specified in the shellmachine-userdel configuration file are executed on shellmachine via ssh. If this file does not exist, userdel $username is the default. If the file exists but is empty, rm -rf $dir is the default instead. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $username and $dir. +
    • Account modification - If a user's home directory changes, the command(s) specified in the shellmachine-usermod configuration file are execute on shellmachine via ssh. If this file does not exist or is empty, [ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $uid.$gid $new_dir; rm -rf $old_dir ) is the default. Otherwise the contents of the file are treated as a double-quoted perl string, with the following variables available: $old_dir, $new_dir, $uid and $gid.
    -
  • bin/svc_acct_sm.export will create Qmail `rcpthosts', `recipientmap' and `virtualdomains' files and Sendmail `virtusertable' and `sendmail.cw' files in the `/var/spool/freeside/export' directory. Using the appropriate configuration files, you can export these files to your remote machines unattemded; see below. +
  • bin/svc_acct_sm.export will create Qmail rcpthosts, recipientmap and virtualdomains files and Sendmail virtusertable and sendmail.cw files in the /usr/local/etc/freeside/export.datasrc directory. Using the appropriate configuration files, you can export these files to your remote machines unattemded:
      -
    • qmailmachines - recipientmap, virtualdomains and rcpthosts are copied to the `/var/qmail/control' directory on the remote machine. Note: If you imported 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. -
    • shellmachine - The command `[ -e homedir/.qmail-default ] || { touch homedir/.qmail-default; chown uid.gid homedir/.qmail-default; }' will be run on this machine for users in the virtualdomains file. -
    • 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. +
    • qmailmachines - recipientmap, virtualdomains and rcpthosts are copied to the /var/qmail/control directory on the remote machine. Note: If you imported qmail configuration files, run the generated /usr/local/etc/freeside/export.datasrc/virtualdomains.FIX on a machine with your user home directories before exporting qmail configuration files. +
    • shellmachine - The command [ -e homedir/.qmail-default ] || { touch homedir/.qmail-default; chown uid.gid homedir/.qmail-default; } will be run on this machine for users in the virtualdomains file. +
    • sendmailmachines - sendmail.cw and virtusertable are copied to the remote machine as /etc/sendmail.cw.new and /etc/virtusertable.new. If no errors occur, they are moved to /etc/sendmail.cw and /etc/virtusertable and the command specified in the sendmailrestart configuration file is executed. (The path can be changed from the default /etc with the sendmailconfigpath configuration file.)
    -
  • site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user `.qmail-' files can be updated. +
  • site_perl/svc_acct_sm.pm - If the qmailmachines configuration file exists and a shellmachine is defined, user .qmail- files can be updated.
      -
    • The command `[ -e homedir/.qmail-domain-default ] || { touch homedir/.qmail-domain-default; chown uid.gid homedir/.qmail-domain-default; }' is run. +
    • The command [ -e homedir/.qmail-domain-default ] || { touch homedir/.qmail-domain-default; chown uid.gid homedir/.qmail-domain-default; } is run.

Unattended remote login - 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. Do not use this feature unless you understand what you are doing! diff --git a/htdocs/docs/index.html b/htdocs/docs/index.html index 20051ca4d..7e3725b61 100644 --- a/htdocs/docs/index.html +++ b/htdocs/docs/index.html @@ -1,23 +1,30 @@ Documentation - +

Documentation

+ diff --git a/htdocs/docs/install.html b/htdocs/docs/install.html index c4784ebf6..d94ffe7fa 100644 --- a/htdocs/docs/install.html +++ b/htdocs/docs/install.html @@ -6,51 +6,79 @@ Before installing, you need: Install the Freeside distribution:
  • Add the user `freeside' to your system. -
  • Add the freeside database to your database engine. (with MySQL) (with PostgreSQL) -
  • Allow the freeside user full access to the freeside database. (with MySQL) (with PostgreSQL) +
  • Allow the freeside user full access to the freeside database. +
      +
    • with MySQL:
      $ mysqladmin -u root password 'set_a_root_database_password'
      +$ mysql -u root -p
      +mysql> GRANT SELECT,INSERT,UPDATE,DELETE,INDEX,ALTER,CREATE,DROP on freeside.* TO freeside@localhost IDENTIFIED BY 'set_a_freeside_database_password';
      +
    • with PostgreSQL +
    +
  • Add the freeside database to your database engine. (with MySQL) (with PostgreSQL)
  • Unpack the tarball:
    gunzip -c fs-x.y.z.tar.gz | tar xvf -
    -
  • Copy or link fs-x.y.z/site_perl to FS in your site_perl directory. (try `perl -V' if unsure)
    mkdir /usr/local/lib/site_perl/FS
    -cp fs-x.y.z/site_perl/* /usr/local/lib/site_perl/FS
    or
    ln -s /full/path/to/fs-x.y.z/site_perl /usr/local/lib/site_perl/FS
    +
  • Build and install the Perl libraries: +
    +$ cd FS/
    +$ perl Makefile.PL
    +$ make
    +$ su
    +# make install UNINST=1
  • Copy or link fs-x.y.z/htdocs to your web server's document space.
    mkdir /usr/local/apache/htdocs/freeside
     cp -r fs-x.y.z/htdocs/* /usr/local/apache/htdocs/freeside
    or
    ln -s /full/path/to/fs-x.y.z/htdocs /usr/local/apache/htdocs/freeside
    -
  • Restrict access to this web interface. (with Apache) +
  • Restrict access to this web interface. (with Apache)
  • Enable CGI execution for files with the `.cgi' extension. (with Apache) -
  • Set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see perlsec: Security Bugs for information and workarounds. +
  • Set ownership and permissions for the web interface. The web interface needs to run as the freeside user - there are several ways to do this. +
      +
    • Use Perl's setuid emulation: see the Security Bugs section of the perlsec manpage.
      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
      -
    • Create the base Freeside directory `/var/spool/freeside', and the subdirectories `conf', `counters', and `export'.
      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
      -
    • Create the necessary configuration files. -
    • Run bin/fs-setup to create the database tables. +
    • Use Apache's suEXEC. +
      cd /usr/local/apache/htdocs/freeside
      +chown -R freeside .
      +chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi
      +
    • Use mod_perl. You should run a separate iteration of Apache[-SSL] as the freeside user. (Warning: The redirect method of CGI.pm 2.36 [as distributed with Perl 5.004_04] is broken under mod_perl. Downlaod the current version from CPAN. Apache 1.3.6 is also highly recommended because of signal handling problems in earlier versions.) +
      cd /usr/local/apache/htdocs/freeside
      +chown -R root .
      +chmod 755 browse/*.cgi edit/*.cgi edit/process/*.cgi misc/*.cgi misc/process/*.cgi search/*.cgi view/*.cgi
      +
    +
  • Create the necessary configuration files. +
  • Create the `/usr/local/etc/freeside/counters.datasrc', and + `/usr/local/etc/freeside/export.datasrc' directories for each datasrc (owned by the freeside user). +
  • As the freeside user, run bin/fs-setup to create the database tables. +
  • Now proceed to the initial administration of your installation.
diff --git a/htdocs/docs/legacy.html b/htdocs/docs/legacy.html index 40e09cb3c..3ab21dab2 100644 --- a/htdocs/docs/legacy.html +++ b/htdocs/docs/legacy.html @@ -4,7 +4,7 @@

Importing legacy data

    -
  • bin/svc_acct.import - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need services (with table svc_acct) as follows: +
  • bin/svc_acct.import - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need services (with table svc_acct) as follows:
    • Most accounts probably have entries in passwd and users (with Port-Limit nonexistant or 1)
    • Some accounts have entries in passwd and users, but with Port-Limit 2 (or more) @@ -13,7 +13,7 @@
    • POP mail accounts have entries in passwd only, and have a particular shell.
    • Everything else in passwd is a shell account.
    -
  • bin/svc_acct_sm.import - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need services as follows: +
  • bin/svc_acct_sm.import - Import qmail ( `virtualdomains' and `rcpthosts' ), or sendmail ( `virtusertable' and `sendmail.cw' ) files. Before running bin/svc_acct_sm.import, you need services as follows:
    • Domain (table svc_acct)
    • Mail alias (table svc_acct_sm) diff --git a/htdocs/docs/man/Bill.txt b/htdocs/docs/man/Bill.txt deleted file mode 100644 index 545dd1a4c..000000000 --- a/htdocs/docs/man/Bill.txt +++ /dev/null @@ -1,29 +0,0 @@ -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 - diff --git a/htdocs/docs/man/CGI.txt b/htdocs/docs/man/CGI.txt deleted file mode 100644 index 54f9b8a6a..000000000 --- a/htdocs/docs/man/CGI.txt +++ /dev/null @@ -1,47 +0,0 @@ -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 - diff --git a/htdocs/docs/man/Conf.txt b/htdocs/docs/man/Conf.txt deleted file mode 100644 index c46c9ee6a..000000000 --- a/htdocs/docs/man/Conf.txt +++ /dev/null @@ -1,47 +0,0 @@ -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 98-sep-6 - diff --git a/htdocs/docs/man/FS.html b/htdocs/docs/man/FS.html new file mode 100644 index 000000000..3d07462af --- /dev/null +++ b/htdocs/docs/man/FS.html @@ -0,0 +1,138 @@ + + +FS - Freeside Perl modules + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS - Freeside Perl modules

      +

      +


      +

      SYNOPSIS

      +

      FS is the unofficial (i.e. non-CPAN) prefix for the Perl module portion of the +Freeside ISP billing software. This includes:

      +

      +

      Utility classes

      +

      the FS::Conf manpage - Freeside configuration values

      +

      the FS::UID manpage - User class (not yet OO)

      +

      the FS::CGI manpage - Non OO-subroutines for the web interface. This is +depriciated. Future development will be focused on the FS::UI user-interface +classes (see below).

      +

      +

      Database record classes

      +

      the FS::Record manpage - Database record base class

      +

      the FS::svc_acct_pop manpage - POP (Point of Presence, not Post +Office Protocol) class

      +

      the FS::part_referral manpage - Referral class

      +

      the FS::cust_main_county manpage - Locale (tax rate) class

      +

      the FS::svc_Common manpage - Service base class

      +

      the FS::svc_acct manpage - Account (shell, RADIUS, POP3) class

      +

      the FS::svc_domain manpage - Domain class

      +

      the FS::domain_record manpage - DNS zone entries

      +

      the FS::svc_acct_sm manpage - Vitual mail alias class

      +

      the FS::svc_www manpage - Web virtual host class.

      +

      the FS::part_svc manpage - Service definition class

      +

      the FS::part_pkg manpage - Package (billing item) definition class

      +

      the FS::pkg_svc manpage - Class linking package (billing item) +definitions (see the FS::part_pkg manpage) with service definitions +(see the FS::part_svc manpage)

      +

      the FS::agent manpage - Agent (reseller) class

      +

      the FS::agent_type manpage - Agent type class

      +

      the FS::type_pkgs manpage - Class linking agent types (see +the FS::agent_type manpage) with package (billing item) definitions +(see the FS::part_pkg manpage)

      +

      the FS::cust_svc manpage - Service class

      +

      the FS::cust_pkg manpage - Package (billing item) class

      +

      the FS::cust_main manpage - Customer class

      +

      the FS::cust_main_invoice manpage - Invoice destination +class

      +

      the FS::cust_bill manpage - Invoice class

      +

      the FS::cust_bill_pkg manpage - Invoice line item class

      +

      the FS::cust_pay manpage - Payment class

      +

      the FS::cust_credit manpage - Credit class

      +

      the FS::cust_refund manpage - Refund class

      +

      the FS::cust_pay_batch manpage - Credit card transaction queue class

      +

      the FS::prepay_credit manpage - Prepaid ``calling card'' credit class.

      +

      the FS::nas manpage - Network Access Server class

      +

      the FS::port manpage - NAS port class

      +

      the FS::session manpage - User login session class

      +

      +

      User Interface classes (under development; not yet usable)

      +

      the FS::UI::Base manpage - User-interface base class

      +

      the FS::UI::Gtk manpage - Gtk user-interface class

      +

      the FS::UI::CGI manpage - CGI (HTML) user-interface class

      +

      the FS::UI::agent manpage - agent table user-interface class

      +

      +

      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.''

      +

      +


      +

      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.

      +

      +


      +

      VERSION

      +

      $Id: FS.html,v 1.3 2001-04-23 12:40:30 ivan Exp $

      +

      +


      +

      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>.

      +

      +


      +

      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.

      +

      +


      +

      SEE ALSO

      +

      perl(1), main Freeside documentation in htdocs/docs/

      +

      +


      +

      BUGS

      +

      The version number of the FS Perl extension differs from the version of the +Freeside distribution, which are both different from the CVS version tag for +each file, which appears under the VERSION heading.

      +

      Those modules which would be useful separately should be pulled out, +renamed appropriately and uploaded to CPAN. So far: DBIx::DBSchema, Net::SSH +and Net::SCP...

      + + + + diff --git a/htdocs/docs/man/FS/Bill.html b/htdocs/docs/man/FS/Bill.html new file mode 100644 index 000000000..cf996ae80 --- /dev/null +++ b/htdocs/docs/man/FS/Bill.html @@ -0,0 +1,32 @@ + + +FS::Bill - Legacy stub + + + + + + + + + + +
      +

      +

      NAME

      +

      +FS::Bill - Legacy stub + +

      +


      +

      SYNOPSIS

      +

      +The functionality of FS::Bill has been integrated into FS::cust_main. + + + + diff --git a/htdocs/docs/man/FS/CGI.html b/htdocs/docs/man/FS/CGI.html new file mode 100644 index 000000000..05f7823b4 --- /dev/null +++ b/htdocs/docs/man/FS/CGI.html @@ -0,0 +1,95 @@ + + +FS::CGI - Subroutines for the web interface + + + + + + + + +

      + + +
      +

      +

      NAME

      +

      FS::CGI - Subroutines for the web interface

      +

      +


      +

      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
      +

      +


      +

      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
      +
      +This is depriciated. Don't use it. +

      Sends headers and an HTML error message.

      +

      +
      eidiot ERROR
      +
      +This is depriciated. Don't use it. +

      Sends headers and an HTML error message, then exits.

      +

      +
      popurl LEVEL
      +
      +Returns current URL with LEVEL levels of path removed from the end (default 0). +

      +
      table
      +
      +Returns HTML tag for beginning a table. +

      +
      itable
      +
      +Returns HTML tag for beginning an (invisible) table. +

      +
      ntable
      +
      +This is getting silly. +

      +

      +


      +

      BUGS

      +

      Not OO.

      +

      Not complete.

      +

      +


      +

      SEE ALSO

      +

      the CGI manpage, the CGI::Base manpage

      + + + + diff --git a/htdocs/docs/man/FS/CGIwrapper.html b/htdocs/docs/man/FS/CGIwrapper.html new file mode 100644 index 000000000..bab5e7f37 --- /dev/null +++ b/htdocs/docs/man/FS/CGIwrapper.html @@ -0,0 +1,16 @@ + + +./FS/FS/CGIwrapper.pm + + + + + + + + + + + + + diff --git a/htdocs/docs/man/FS/Conf.html b/htdocs/docs/man/FS/Conf.html new file mode 100644 index 000000000..7b1613efd --- /dev/null +++ b/htdocs/docs/man/FS/Conf.html @@ -0,0 +1,81 @@ + + +FS::Conf - Read access to Freeside configuration values + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::Conf - Read access to Freeside configuration values

      +

      +


      +

      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');
      +

      +


      +

      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. A directory arguement is required if +$FS::Conf::default_dir has not been set. +

      +
      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

      +

      Write access (with locking) should be implemented.

      +

      +


      +

      SEE ALSO

      +

      config.html from the base documentation contains a list of configuration files.

      + + + + diff --git a/htdocs/docs/man/FS/Invoice.html b/htdocs/docs/man/FS/Invoice.html new file mode 100644 index 000000000..cc837be2e --- /dev/null +++ b/htdocs/docs/man/FS/Invoice.html @@ -0,0 +1,32 @@ + + +FS::Invoice - Legacy stub + + + + + + + + + + +
      +

      +

      NAME

      +

      +FS::Invoice - Legacy stub + +

      +


      +

      SYNOPSIS

      +

      +The functionality of FS::Invoice has been integrated in FS::cust_bill. + + + + diff --git a/htdocs/docs/man/FS/Record.html b/htdocs/docs/man/FS/Record.html new file mode 100644 index 000000000..cc3d37795 --- /dev/null +++ b/htdocs/docs/man/FS/Record.html @@ -0,0 +1,342 @@ + + +FS::Record - Database record objects + + + + + + + + +

      + + +
      +

      +

      NAME

      +

      FS::Record - Database record objects

      +

      +


      +

      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
      +

      +


      +

      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.

      +

      +


      +

      CONSTRUCTORS

      +
      +
      new [ TABLE, ] HASHREF
      +
      +Creates a new record. It doesn't store it in the database, though. See +insert for that. +

      Note that the object stores this hash reference, not a distinct copy of the +hash it points to. You can ask the object for a copy with the hash +method.

      +

      TABLE can only be omitted when a dervived class overrides the table method.

      +

      +
      qsearch TABLE, HASHREF, SELECT, EXTRA_SQL
      +
      +Searches the database for all records matching (at least) the key/value pairs +in HASHREF. Returns all the records found as `FS::TABLE' objects if that +module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record +objects. +

      ###oops, argh, FS::Record::new only lets us create database fields. +#Normal behaviour if SELECT is not specified is `*', as in +#SELECT * FROM table WHERE .... However, there is an experimental new +#feature where you can specify SELECT - remember, the objects returned, +#although blessed into the appropriate `FS::TABLE' package, will only have the +#fields you specify. This might have unwanted results if you then go calling +#regular FS::TABLE methods +#on it.

      +

      +
      qsearchs TABLE, HASHREF
      +
      +Same as qsearch, except that if more than one record matches, it carps but +returns the first. If this happens, you either made a logic error in asking +for a single item, or your data is corrupted. +

      +

      +


      +

      METHODS

      +
      +
      table
      +
      +Returns the table name. +

      +
      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. +

      +
      insert
      +
      +Inserts this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      add
      +
      +Depriciated (use insert instead). +

      +
      delete
      +
      +Delete this record from the database. If there is an error, returns the error, +otherwise returns false. +

      +
      del
      +
      +Depriciated (use delete instead). +

      +
      replace OLD_RECORD
      +
      +Replace the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      rep
      +
      +Depriciated (use replace instead). +

      +
      check
      +
      +Not yet implemented, croaks. Derived classes should provide a check method. +

      +
      unique COLUMN
      +
      +Replaces COLUMN in record with a unique number. Called by the add method +on primary keys and single-field unique columns (see the DBIx::DBSchema::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 [ COUNTRY ]
      +
      +Check/untaint phone numbers. May be null. If there is an error, returns +the error, otherwise returns false. +

      Takes an optional two-letter ISO country code; without it or with unsupported +countries, ut_phonen simply calls ut_alphan.

      +

      +
      ut_ip COLUMN
      +
      +Check/untaint ip addresses. IPv4 only for now. +

      +
      ut_ipn COLUMN
      +
      +Check/untaint ip addresses. IPv4 only for now. May be null. +

      +
      ut_domain COLUMN
      +
      +Check/untaint host and domain names. +

      +
      ut_anything COLUMN
      +
      +Untaints arbitrary data. Be careful. +

      +
      fields [ TABLE ]
      +
      +This can be used as both a subroutine and a method call. It returns a list +of the columns in this record's table, or an explicitly specified table. +(See the DBIx::DBSchema::Table manpage). +

      +

      +


      +

      SUBROUTINES

      +
      +
      reload_dbdef([FILENAME])
      +
      +Load a database definition (see the DBIx::DBSchema manpage), optionally from a +non-default filename. This command is executed at startup unless +$FS::Record::setup_hack is true. Returns a DBIx::DBSchema 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 DBI/``quote'') unless VALUE is a number and the column +type (see the FS::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.

      +

      +

      +


      +

      VERSION

      +

      $Id: Record.html,v 1.3 2001-04-23 12:40:30 ivan Exp $

      +

      +


      +

      BUGS

      +

      This module should probably be renamed, since much of the functionality is +of general use. It is not completely unlike Adapter::DBI (see below).

      +

      Exported qsearch and qsearchs should be depriciated in favor of method calls +(against an FS::Record object like the old search and searchs that qsearch +and qsearchs were on top of.)

      +

      The whole fields / hfields mess should be removed.

      +

      The various WHERE clauses should be subroutined.

      +

      table string should be depriciated in favor of FS::dbdef_table.

      +

      No doubt we could benefit from a Tied hash. Documenting how exists / defined +true maps to the database (and WHERE clauses) would also help.

      +

      The ut_ methods should ask the dbdef for a default length.

      +

      ut_sqltype (like ut_varchar) should all be defined

      +

      A fallback check method should be provided which uses the dbdef.

      +

      The ut_money method assumes money has two decimal digits.

      +

      The Pg money kludge in the new method only strips `$'.

      +

      The ut_phonen method assumes US-style phone numbers.

      +

      The _quote function should probably use ut_float instead of a regex.

      +

      All the subroutines probably should be methods, here or elsewhere.

      +

      Probably should borrow/use some dbdef methods where appropriate (like sub +fields)

      +

      As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc, +or allow it to be set. Working around it is ugly any way around - DBI should +be fixed. (only affects RDBMS which return uppercase column names)

      +

      +


      +

      SEE ALSO

      +

      the DBIx::DBSchema manpage, the FS::UID manpage, DBI

      +

      Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.

      + + + + diff --git a/htdocs/docs/man/FS/SSH.html b/htdocs/docs/man/FS/SSH.html new file mode 100644 index 000000000..4368b8c11 --- /dev/null +++ b/htdocs/docs/man/FS/SSH.html @@ -0,0 +1,104 @@ + + +FS::SSH - Subroutines to call ssh and scp + + + + + + + + + + +
      +

      +

      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

      +

      +ssh, scp, IPC::Open2, IPC::Open3 + + + +

      + + + diff --git a/htdocs/docs/man/FS/SignupClient.html b/htdocs/docs/man/FS/SignupClient.html new file mode 100644 index 000000000..0c621edcb --- /dev/null +++ b/htdocs/docs/man/FS/SignupClient.html @@ -0,0 +1,125 @@ + + +FS::SignupClient - Freeside signup client API + + + + + + + + + + +
      +

      +

      NAME

      +

      +FS::SignupClient - Freeside signup client API + +

      +


      +

      SYNOPSIS

      +

      +

        use FS::SignupClient qw( signup_info new_customer );
      +
      +

      +

        ( $locales, $packages, $pops ) = signup_info;
      +
      +

      +

        $error = new_customer ( {
      +    'first'          => $first,
      +    'last'           => $last,
      +    'ss'             => $ss,
      +    'comapny'        => $company,
      +    'address1'       => $address1,
      +    'address2'       => $address2,
      +    'city'           => $city,
      +    'county'         => $county,
      +    'state'          => $state,
      +    'zip'            => $zip,
      +    'country'        => $country,
      +    'daytime'        => $daytime,
      +    'night'          => $night,
      +    'fax'            => $fax,
      +    'payby'          => $payby,
      +    'payinfo'        => $payinfo,
      +    'paydate'        => $paydate,
      +    'payname'        => $payname,
      +    'invoicing_list' => $invoicing_list,
      +    'pkgpart'        => $pkgpart,
      +    'username'       => $username,
      +    '_password'       => $password,
      +    'popnum'         => $popnum,
      +  } );
      +
      +

      +


      +

      DESCRIPTION

      +

      +This module provides an API for a remote signup server. + +

      +It needs to be run as the freeside user. Because of this, the program which +calls these subroutines should be written very carefully. + +

      +


      +

      SUBROUTINES

      +
      +
      signup_info
      +

      +Returns three array references of hash references. + +

      +The first set of hash references is of allowable locales. Each hash +reference has the following keys: taxnum state county country + +

      +The second set of hash references is of allowable packages. Each hash +reference has the following keys: pkgpart pkg + +

      +The third set of hash references is of allowable POPs (Points Of Presence). +Each hash reference has the following keys: popnum city state ac exch + +

      new_customer HASHREF
      +

      +Adds a customer to the remote Freeside system. Requires a hash reference as +a paramater with the following keys: first last ss comapny address1 +address2 city county state zip country daytime night fax payby payinfo +paydate payname invoicing_list pkgpart username _password popnum + +

      +Returns a scalar error message, or the empty string for success. + +

      +

      +


      +

      VERSION

      +

      +$Id: SignupClient.html,v 1.1 2001-04-23 12:41:57 ivan Exp $ + +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      +fs_signupd, FS::SignupServer, FS::cust_main + + + + + + diff --git a/htdocs/docs/man/FS/UI/Base.html b/htdocs/docs/man/FS/UI/Base.html new file mode 100644 index 000000000..96c60847d --- /dev/null +++ b/htdocs/docs/man/FS/UI/Base.html @@ -0,0 +1,100 @@ + + +FS::UI::Base - Base class for all user-interface objects + + + + + + + + +

      + + +
      +

      +

      NAME

      +

      FS::UI::Base - Base class for all user-interface objects

      +

      +


      +

      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;
      +

      +


      +

      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.

      +

      +


      +

      METHODS

      +
      +
      new
      +
      +
      browse
      +
      +
      title
      +
      +
      addwidget
      +
      +
      +

      +


      +

      VERSION

      +

      $Id: Base.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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.

      +

      +


      +

      SEE ALSO

      +

      the FS::UI::Gtk manpage, the FS::UI::CGI manpage

      +

      +


      +

      HISTORY

      +

      $Log: Base.html,v $ +

      Revision 1.3 2001-04-23 12:40:31 ivan +

      documentation and webdemo updates +

      +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.

      + + + + diff --git a/htdocs/docs/man/FS/UI/CGI.html b/htdocs/docs/man/FS/UI/CGI.html new file mode 100644 index 000000000..49991f1aa --- /dev/null +++ b/htdocs/docs/man/FS/UI/CGI.html @@ -0,0 +1,94 @@ + + +FS::UI::CGI - Base class for CGI user-interface objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::UI::CGI - Base class for CGI user-interface objects

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::UI::CGI object represents a CGI interface object.

      +

      +


      +

      METHODS

      +
      +
      new
      +
      +
      _header
      +
      +
      _footer
      +
      +
      interface
      +
      +Returns the string `CGI'. Useful for the author of a table-specific UI class +to conditionally specify certain behaviour. +

      +

      +


      +

      VERSION

      +

      $Id: CGI.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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.

      +

      +


      +

      SEE ALSO

      +

      the FS::UI::Base manpage

      +

      +


      +

      HISTORY

      +

      $Log: CGI.html,v $ +

      Revision 1.3 2001-04-23 12:40:31 ivan +

      documentation and webdemo updates +

      +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.

      + + + + diff --git a/htdocs/docs/man/FS/UI/Gtk.html b/htdocs/docs/man/FS/UI/Gtk.html new file mode 100644 index 000000000..24d620087 --- /dev/null +++ b/htdocs/docs/man/FS/UI/Gtk.html @@ -0,0 +1,91 @@ + + +FS::UI::Gtk - Base class for Gtk user-interface objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::UI::Gtk - Base class for Gtk user-interface objects

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::UI::Gtk object represents a Gtk user interface object.

      +

      +


      +

      METHODS

      +
      +
      new
      +
      +
      interface
      +
      +Returns the string `Gtk'. Useful for the author of a table-specific UI class +to conditionally specify certain behaviour. +

      +

      +


      +

      VERSION

      +

      $Id: Gtk.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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 BUGS in the FS::UI::CGI manpage.

      +

      Still some small bits of widget code same as FS::UI::CGI.

      +

      +


      +

      SEE ALSO

      +

      the FS::UI::Base manpage

      +

      +


      +

      HISTORY

      +

      $Log: Gtk.html,v $ +

      Revision 1.3 2001-04-23 12:40:31 ivan +

      documentation and webdemo updates +

      +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.

      + + + + diff --git a/htdocs/docs/man/FS/UI/agent.html b/htdocs/docs/man/FS/UI/agent.html new file mode 100644 index 000000000..8608e4ef4 --- /dev/null +++ b/htdocs/docs/man/FS/UI/agent.html @@ -0,0 +1,16 @@ + + +./FS/FS/UI/agent.pm + + + + + + + + + + + + + diff --git a/htdocs/docs/man/FS/UID.html b/htdocs/docs/man/FS/UID.html new file mode 100644 index 000000000..9c4da492b --- /dev/null +++ b/htdocs/docs/man/FS/UID.html @@ -0,0 +1,142 @@ + + +FS::UID - Subroutines for database login and assorted other stuff + + + + + + + + + + + +
      +

      +

      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 $user;
      +
      +  $cgi = new CGI;
      +  $dbh = cgisuidsetup($cgi);
      +
      +  $dbh = dbh;
      +
      +  $datasrc = datasrc;
      +
      +  $driver_name = driver_name;
      +

      +


      +

      DESCRIPTION

      +

      Provides a hodgepodge of subroutines.

      +

      +


      +

      SUBROUTINES

      +
      +
      adminsuidsetup USER
      +
      +Sets the user to USER (see config.html from the base documentation). +Cleans the environment. +Make sure the script is running as freeside, or setuid freeside. +Opens a connection to the database. +Swaps real and effective UIDs. +Runs any defined callbacks (see below). +Returns the DBI database handle (usually you don't need this). +

      +
      cgisuidsetup CGI_object
      +
      +Takes a single argument, which is a CGI (see the CGI manpage) or Apache (see Apache) +object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup. +

      +
      cgi
      +
      +Returns the CGI (see the CGI manpage) object. +

      +
      dbh
      +
      +Returns the DBI database handle. +

      +
      datasrc
      +
      +Returns the DBI data source. +

      +
      driver_name
      +
      +Returns just the driver name portion of the DBI data source. +

      +
      getotaker
      +
      +Returns the current Freeside user. +

      +
      cgisetotaker
      +
      +Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm +object (see the CGI manpage) or an Apache object (see Apache). Support for CGI::Base +and derived classes is depriciated. +

      +
      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. +

      +
      getsecrets [ USER ]
      +
      +Sets the user to USER, if supplied. +Sets and returns the DBI datasource, username and password for this user from +the `/usr/local/etc/freeside/mapsecrets' file. +

      +

      +


      +

      CALLBACKS

      +

      Warning: this interface is likely to change in future releases.

      +

      A package can install a callback to be run in adminsuidsetup by putting a +coderef into the hash %FS::UID::callback :

      +
      +    $coderef = sub { warn "Hi, I'm returning your call!" };
      +    $FS::UID::callback{'Package::Name'};
      +

      +


      +

      VERSION

      +

      $Id: UID.html,v 1.3 2001-04-23 12:40:30 ivan Exp $

      +

      +


      +

      BUGS

      +

      Too many package-global variables.

      +

      Not OO.

      +

      No capabilities yet. When mod_perl and Authen::DBI are implemented, +cgisuidsetup will go away as well.

      +

      Goes through contortions to support non-OO syntax with multiple datasrc's.

      +

      Callbacks are inelegant.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the CGI manpage, DBI, config.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/agent.html b/htdocs/docs/man/FS/agent.html new file mode 100644 index 000000000..39d89a770 --- /dev/null +++ b/htdocs/docs/man/FS/agent.html @@ -0,0 +1,121 @@ + + +FS::agent - Object methods for agent records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::agent - Object methods for agent records

      +

      +


      +

      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};
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Creates a new agent. To add the agent to the database, see 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. +

      +
      agent_type
      +
      +Returns the FS::agent_type object (see the FS::agent_type manpage) for this agent. +

      +
      pkgpart_hashref
      +
      +Returns a hash reference. The keys of the hash are pkgparts. The value is +true if this agent may purchase the specified package definition. See +the FS::part_pkg manpage. +

      +

      +


      +

      VERSION

      +

      $Id: agent.html,v 1.3 2001-04-23 12:40:30 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::agent_type manpage, the FS::cust_main manpage, the FS::part_pkg manpage, +schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/agent_type.html b/htdocs/docs/man/FS/agent_type.html new file mode 100644 index 000000000..b34940752 --- /dev/null +++ b/htdocs/docs/man/FS/agent_type.html @@ -0,0 +1,126 @@ + + +FS::agent_type - Object methods for agent_type records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::agent_type - Object methods for agent_type records

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Creates a new agent type. To add the agent type to the database, see +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. +

      +
      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 +the FS::part_pkg manpage. +

      +
      type_pkgs
      +
      +Returns all FS::type_pkgs objects (see the FS::type_pkgs manpage) for this agent type. +

      +
      pkgpart
      +
      +Returns the pkgpart of all package definitions (see the FS::part_pkg manpage) for this +agent type. +

      +

      +


      +

      VERSION

      +

      $Id: agent_type.html,v 1.3 2001-04-23 12:40:30 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::agent manpage, the FS::type_pkgs manpage, the FS::cust_main manpage, +the FS::part_pkg manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_bill.html b/htdocs/docs/man/FS/cust_bill.html new file mode 100644 index 000000000..a59542c76 --- /dev/null +++ b/htdocs/docs/man/FS/cust_bill.html @@ -0,0 +1,161 @@ + + +FS::cust_bill - Object methods for cust_bill records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_bill - Object methods for cust_bill records

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::cust_bill object represents an invoice; a declaration that a customer +owes you money. The specific charges are itemized as cust_bill_pkg records +(see the FS::cust_bill_pkg manpage). 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 perlfunc/``time''. Also see +the Time::Local manpage and the Date::Parse manpage for conversion functions.
      +
      +
      charged - amount of this invoice
      +
      +
      printed - how many times this invoice has been printed automatically +(see collect in the FS::cust_main manpage).
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new invoice. To add the invoice to the database, see 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. +

      +
      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 printed may be changed. 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. +

      +
      owed
      +
      +Returns the amount owed (still outstanding) on this invoice, which is charged +minus all payments (see the FS::cust_pay manpage). +

      +
      print_text [TIME];
      +
      +Returns an text invoice, as a list of lines. +

      TIME an optional value used to control the printing of overdue messages. The +default is now. It isn't the date of the invoice; that's the `_date' field. +It is specified as a UNIX timestamp; see perlfunc/``time''. Also see +the Time::Local manpage and the Date::Parse manpage for conversion functions.

      +

      +

      +


      +

      VERSION

      +

      $Id: cust_bill.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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?)

      +

      +


      +

      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.

      + + + + diff --git a/htdocs/docs/man/FS/cust_bill_pkg.html b/htdocs/docs/man/FS/cust_bill_pkg.html new file mode 100644 index 000000000..2cdd8952e --- /dev/null +++ b/htdocs/docs/man/FS/cust_bill_pkg.html @@ -0,0 +1,112 @@ + + +FS::cust_bill_pkg - Object methods for cust_bill_pkg records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_bill_pkg - Object methods for cust_bill_pkg records

      +

      +


      +

      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;
      +

      +


      +

      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) or 0 for the special virtual sales tax package
      +
      +
      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 perlfunc/``time''. Also +see the Time::Local manpage and the Date::Parse manpage for conversion functions.

      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new line item. To add the line item to the database, see +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. +

      +

      +


      +

      VERSION

      +

      $Id: cust_bill_pkg.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_bill manpage, the FS::cust_pkg manpage, the FS::cust_main manpage, schema.html +from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_credit.html b/htdocs/docs/man/FS/cust_credit.html new file mode 100644 index 000000000..f08424561 --- /dev/null +++ b/htdocs/docs/man/FS/cust_credit.html @@ -0,0 +1,118 @@ + + +FS::cust_credit - Object methods for cust_credit records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_credit - Object methods for cust_credit records

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::cust_credit object represents a credit; the equivalent of a negative +cust_bill record (see the FS::cust_bill manpage). 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
      +
      +
      _date - specified as a UNIX timestamp; see perlfunc/``time''. 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

      +
      +
      new HASHREF
      +
      +Creates a new credit. To add the credit to the database, see insert. +

      +
      insert
      +
      +Adds this credit to the database (``Posts'' the credit). If there is an error, +returns the error, otherwise returns false. +

      +
      delete
      +
      +Currently unimplemented. +

      +
      replace OLD_RECORD
      +
      +Credits may not be modified; there would then be no record the credit was ever +posted. +

      +
      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. +

      +
      cust_refund
      +
      +Returns all refunds (see the FS::cust_refund manpage) for this credit. +

      +
      credited
      +
      +Returns the amount of this credit that is still outstanding; which is +amount minus all refunds (see the FS::cust_refund manpage). +

      +

      +


      +

      VERSION

      +

      $Id: cust_credit.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      The delete method.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_refund manpage, the FS::cust_bill manpage, schema.html from the base +documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_main.html b/htdocs/docs/man/FS/cust_main.html new file mode 100644 index 000000000..c5df1da12 --- /dev/null +++ b/htdocs/docs/man/FS/cust_main.html @@ -0,0 +1,252 @@ + + +FS::cust_main - Object methods for cust_main records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_main - Object methods for cust_main records

      +

      +


      +

      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',
      +                          ;
      +

      +


      +

      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)
      +
      +
      fax - phone (optional)
      +
      +
      payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see the FS::prepay_credit manpage and sets billing type to BILL)
      +
      +
      payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see the FS::prepay_credit manpage)
      +
      +
      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

      +
      +
      new HASHREF
      +
      +Creates a new customer. To add the customer to the database, see 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. +

      There is a special insert mode in which you pass a data structure to the insert +method containing FS::cust_pkg and FS::svc_tablename objects. When +running under a transactional database, all records are inserted atomicly, or +the transaction is rolled back. There should be a better explanation of this, +but until then, here's an example:

      +
      +  use Tie::RefHash;
      +  tie %hash, 'Tie::RefHash'; #this part is important
      +  %hash = {
      +    $cust_pkg => [ $svc_acct ],
      +  };
      +  $cust_main->insert( \%hash );
      +

      +
      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 cancel in the FS::cust_pkg manpage).

      +

      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 the FS::cust_bill manpage), +or credits (see the FS::cust_credit 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 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 +perlfunc/``time''). 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 perlfunc/``time''). 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). +

      +
      invoicing_list [ ARRAYREF ]
      +
      +If an arguement is given, sets these email addresses as invoice recipients +(see the FS::cust_main_invoice manpage). Errors are not fatal and are not reported +(except as warnings), so use check_invoicing_list first. +

      Returns a list of email addresses (with svcnum entries expanded).

      +

      Note: You can clear the invoicing list by passing an empty ARRAYREF. You can +check it without disturbing anything by passing nothing.

      +

      This interface may change in the future.

      +

      +
      check_invoicing_list ARRAYREF
      +
      +Checks these arguements as valid input for the invoicing_list method. If there +is an error, returns the error, otherwise returns false. +

      +

      +


      +

      VERSION

      +

      $Id: cust_main.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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).

      +

      +


      +

      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::cust_main_invoice manpage, +the FS::UID manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_main_county.html b/htdocs/docs/man/FS/cust_main_county.html new file mode 100644 index 000000000..575eaedca --- /dev/null +++ b/htdocs/docs/man/FS/cust_main_county.html @@ -0,0 +1,106 @@ + + +FS::cust_main_county - Object methods for cust_main_county objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_main_county - Object methods for cust_main_county objects

      +

      +


      +

      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;
      +

      +


      +

      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
      +
      +
      country
      +
      +
      tax - percentage
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new tax rate. To add the tax rate to the database, see 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. +

      +

      +


      +

      VERSION

      +

      $Id: cust_main_county.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_main manpage, the FS::cust_bill manpage, schema.html from the base +documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_main_invoice.html b/htdocs/docs/man/FS/cust_main_invoice.html new file mode 100644 index 000000000..7a3719711 --- /dev/null +++ b/htdocs/docs/man/FS/cust_main_invoice.html @@ -0,0 +1,111 @@ + + +FS::cust_main_invoice - Object methods for cust_main_invoice records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_main_invoice - Object methods for cust_main_invoice records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::cust_main_invoice;
      +
      +  $record = new FS::cust_main_invoice \%hash;
      +  $record = new FS::cust_main_invoice { 'column' => 'value' };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +
      +  $email_address = $record->address;
      +

      +


      +

      DESCRIPTION

      +

      An FS::cust_main_invoice object represents an invoice destination. FS::cust_main_invoice inherits from +FS::Record. The following fields are currently supported:

      +
      +
      destnum - primary key
      +
      +
      custnum - customer (see the FS::cust_main manpage)
      +
      +
      dest - Invoice destination: If numeric, a svcnum (see the FS::svc_acct manpage), if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist)
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new invoice destination. To add the invoice destination to the database, see insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      check
      +
      +Checks all fields to make sure this is a valid invoice destination. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. +

      +
      checkdest
      +
      +Checks the dest field only. +

      +
      address
      +
      +Returns the literal email address for this record (or `POST'). +

      +

      +


      +

      VERSION

      +

      $Id: cust_main_invoice.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_main manpage

      + + + + diff --git a/htdocs/docs/man/FS/cust_pay.html b/htdocs/docs/man/FS/cust_pay.html new file mode 100644 index 000000000..dc7b54c8d --- /dev/null +++ b/htdocs/docs/man/FS/cust_pay.html @@ -0,0 +1,108 @@ + + +FS::cust_pay - Object methods for cust_pay objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_pay - Object methods for cust_pay objects

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::cust_pay object represents a payment; the transfer of money from a +customer. FS::cust_pay inherits from FS::Record. The following fields are +currently supported:

      +
      +
      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 perlfunc/``time''. 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

      +
      +
      new HASHREF
      +
      +Creates a new payment. To add the payment to the databse, see 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. +

      +

      +


      +

      VERSION

      +

      $Id: cust_pay.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      Delete and replace methods.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_bill manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_pay_batch.html b/htdocs/docs/man/FS/cust_pay_batch.html new file mode 100644 index 000000000..b7637bc6d --- /dev/null +++ b/htdocs/docs/man/FS/cust_pay_batch.html @@ -0,0 +1,132 @@ + + +FS::cust_pay_batch - Object methods for batch cards + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_pay_batch - Object methods for batch cards

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::cust_pay_batch;
      +
      +  $record = new FS::cust_pay_batch \%hash;
      +  $record = new FS::cust_pay_batch { 'column' => 'value' };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +

      +


      +

      DESCRIPTION

      +

      An FS::cust_pay_batch object represents a credit card transaction ready to be +batched (sent to a processor). FS::cust_pay_batch inherits from FS::Record. +Typically called by the collect method of an FS::cust_main object. The +following fields are currently supported:

      +
      +
      trancode - 77 for charges
      +
      +
      cardnum
      +
      +
      exp - card expiration
      +
      +
      amount
      +
      +
      invnum - invoice
      +
      +
      custnum - customer
      +
      +
      payname - name on card
      +
      +
      first - name
      +
      +
      last - name
      +
      +
      address1
      +
      +
      address2
      +
      +
      city
      +
      +
      state
      +
      +
      zip
      +
      +
      country
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new record. To add the record to the database, see insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      delete
      +
      +Delete this record from the database. If there is an error, returns the error, +otherwise returns false. +

      +
      replace OLD_RECORD
      +
      +#inactive +# +#Replaces the OLD_RECORD with this one in the database. If there is an error, +#returns the error, otherwise returns false. +

      +
      check
      +
      +Checks all fields to make sure this is a valid transaction. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. +

      +

      +


      +

      VERSION

      +

      $Id: cust_pay_batch.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      There should probably be a configuration file with a list of allowed credit +card types.

      +

      +


      +

      SEE ALSO

      +

      the FS::cust_main manpage, the FS::Record manpage

      + + + + diff --git a/htdocs/docs/man/FS/cust_pkg.html b/htdocs/docs/man/FS/cust_pkg.html new file mode 100644 index 000000000..19c8ff842 --- /dev/null +++ b/htdocs/docs/man/FS/cust_pkg.html @@ -0,0 +1,205 @@ + + +FS::cust_pkg - Object methods for cust_pkg objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_pkg - Object methods for cust_pkg objects

      +

      +


      +

      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 ] );
      +

      +


      +

      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 perlfunc/``time''. Also see the Time::Local manpage and the Date::Parse manpage for +conversion functions.

      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Create a new billing item. To add the item to the database, see insert. +

      +
      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;
      +

      }

      +

      +
      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. +

      +
      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 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.

      +

      +
      part_pkg
      +
      +Returns the definition for this billing item, as an FS::part_pkg object (see +the FS::part_pkg manpage). +

      +
      labels
      +
      +Returns a list of lists, calling the label method for all services +(see the FS::cust_svc manpage) of this billing item. +

      +

      +


      +

      SUBROUTINES

      +
      +
      order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
      +
      +CUSTNUM is a customer (see the FS::cust_main manpage) +

      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).

      +

      +

      +


      +

      VERSION

      +

      $Id: cust_pkg.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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.

      +

      +


      +

      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

      + + + + diff --git a/htdocs/docs/man/FS/cust_refund.html b/htdocs/docs/man/FS/cust_refund.html new file mode 100644 index 000000000..8162c0b78 --- /dev/null +++ b/htdocs/docs/man/FS/cust_refund.html @@ -0,0 +1,108 @@ + + +FS::cust_refund - Object method for cust_refund objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_refund - Object method for cust_refund objects

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::cust_refund represents a refund: the transfer of money to a customer; +equivalent to a negative payment (see the FS::cust_pay manpage). 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 perlfunc/``time''. 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

      +
      +
      new HASHREF
      +
      +Creates a new refund. To add the refund to the database, see 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. +

      +

      +


      +

      VERSION

      +

      $Id: cust_refund.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      Delete and replace methods.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_credit manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/cust_svc.html b/htdocs/docs/man/FS/cust_svc.html new file mode 100644 index 000000000..19416d5b7 --- /dev/null +++ b/htdocs/docs/man/FS/cust_svc.html @@ -0,0 +1,118 @@ + + +FS::cust_svc - Object method for cust_svc objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::cust_svc - Object method for cust_svc objects

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Creates a new service. To add the refund to the database, see 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. +

      +
      label
      +
      +Returns a list consisting of: +- The name of this service (from part_svc) +- A meaningful identifier (username, domain, or mail alias) +- The table name (i.e. svc_domain) for this service +

      +

      +


      +

      VERSION

      +

      $Id: cust_svc.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      Behaviour of changing the svcpart of cust_svc records is undefined and should +possibly be prohibited, and pkg_svc records are not checked.

      +

      pkg_svc records are not checked in general (here).

      +

      Deleting this record doesn't check or delete the svc_* record associated +with this record.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_pkg manpage, the FS::part_svc manpage, the FS::pkg_svc manpage, +schema.html from the base documentation

      + + + + diff --git a/htdocs/docs/man/FS/dbdef.html b/htdocs/docs/man/FS/dbdef.html new file mode 100644 index 000000000..a986ad95b --- /dev/null +++ b/htdocs/docs/man/FS/dbdef.html @@ -0,0 +1,97 @@ + + +FS::dbdef - Database objects + + + + + + + + + + +
      +

      +

      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

      +

      +FS::dbdef_table, FS::Record, + +

      + + + diff --git a/htdocs/docs/man/FS/dbdef_colgroup.html b/htdocs/docs/man/FS/dbdef_colgroup.html new file mode 100644 index 000000000..8b9e12baf --- /dev/null +++ b/htdocs/docs/man/FS/dbdef_colgroup.html @@ -0,0 +1,86 @@ + + +FS::dbdef_colgroup - Column group objects + + + + + + + + + + +
      +

      +

      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

      +

      +FS::dbdef_table, FS::dbdef_unique, FS::dbdef_index, +FS::dbdef_column, FS::dbdef, perldsc + + + + + + diff --git a/htdocs/docs/man/FS/dbdef_column.html b/htdocs/docs/man/FS/dbdef_column.html new file mode 100644 index 000000000..6a5ebc3c1 --- /dev/null +++ b/htdocs/docs/man/FS/dbdef_column.html @@ -0,0 +1,118 @@ + + +FS::dbdef_column - Column object + + + + + + + +

      + + +
      +

      +

      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 FS::dbdef_table). + +

      +


      +

      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 DBD::mysql or DBD::Pg, will use engine-specific syntax. + +

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      +FS::dbdef_table, FS::dbdef, DBI + + + +

      +


      +

      VERSION

      +

      +$Id: dbdef_column.html,v 1.2 2000-03-03 18:22:43 ivan Exp $ + + + + diff --git a/htdocs/docs/man/FS/dbdef_index.html b/htdocs/docs/man/FS/dbdef_index.html new file mode 100644 index 000000000..9d0d12a76 --- /dev/null +++ b/htdocs/docs/man/FS/dbdef_index.html @@ -0,0 +1,58 @@ + + +FS::dbdef_unique.pm - Index object + + + + + + + +

      + + +
      +

      +

      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 (FS::dbdef_table). FS::dbdef_unique inherits from FS::dbdef_colgroup. + +

      +


      +

      BUGS

      +

      +Is this empty subclass needed? + +

      +


      +

      SEE ALSO

      +

      +FS::dbdef_colgroup, FS::dbdef_record, FS::Record + + + + + + diff --git a/htdocs/docs/man/FS/dbdef_table.html b/htdocs/docs/man/FS/dbdef_table.html new file mode 100644 index 000000000..a2442729f --- /dev/null +++ b/htdocs/docs/man/FS/dbdef_table.html @@ -0,0 +1,144 @@ + + +FS::dbdef_table - Table objects + + + + + + + +

      + + +
      +

      +

      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 FS::dbdef_column) for ``column''. + +

      sql_create_table [ $datasrc ]
      +

      +Returns an array of SQL statments to create this table. + +

      +If passed a DBI $datasrc specifying DBD::mysql, will use MySQL-specific syntax. Non-standard syntax for other engines (if +applicable) may also be supported in the future. + +

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      +FS::dbdef, FS::dbdef_unique, FS::dbdef_index, FS::dbdef_unique, +DBI + + + +

      +


      +

      VERSION

      +

      +$Id: dbdef_table.html,v 1.2 2000-03-03 18:22:43 ivan Exp $ + + + + diff --git a/htdocs/docs/man/FS/dbdef_unique.html b/htdocs/docs/man/FS/dbdef_unique.html new file mode 100644 index 000000000..201f3aa61 --- /dev/null +++ b/htdocs/docs/man/FS/dbdef_unique.html @@ -0,0 +1,58 @@ + + +FS::dbdef_unique.pm - Unique object + + + + + + + +

      + + +
      +

      +

      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 (FS::dbdef_table). FS::dbdef_unique inherits from FS::dbdef_colgroup. + +

      +


      +

      BUGS

      +

      +Is this empty subclass needed? + +

      +


      +

      SEE ALSO

      +

      +FS::dbdef_colgroup, FS::dbdef_record, FS::Record + + + + + + diff --git a/htdocs/docs/man/FS/domain_record.html b/htdocs/docs/man/FS/domain_record.html new file mode 100644 index 000000000..78601b4d0 --- /dev/null +++ b/htdocs/docs/man/FS/domain_record.html @@ -0,0 +1,122 @@ + + +FS::domain_record - Object methods for domain_record records + + + + + + + + +

      + + +
      +

      +

      NAME

      +

      FS::domain_record - Object methods for domain_record records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::domain_record;
      +
      +  $record = new FS::domain_record \%hash;
      +  $record = new FS::domain_record { 'column' => 'value' };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +

      +


      +

      DESCRIPTION

      +

      An FS::domain_record object represents an entry in a DNS zone. +FS::domain_record inherits from FS::Record. The following fields are currently +supported:

      +
      +
      recnum - primary key
      +
      +
      svcnum - Domain (see the FS::svc_domain manpage) of this entry
      +
      +
      reczone - partial (or full) zone for this entry
      +
      +
      recaf - address family for this entry, currently only `IN' is recognized.
      +
      +
      rectype - record type for this entry (A, MX, etc.)
      +
      +
      recdata - data for this entry
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new entry. To add the example to the database, see insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      check
      +
      +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. +

      +

      +


      +

      VERSION

      +

      $Id: domain_record.html,v 1.1 2001-04-23 12:41:57 ivan Exp $

      +

      +


      +

      BUGS

      +

      The data validation doesn't check everything it could. In particular, +there is no protection against bad data that passes the regex, duplicate +SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of +course, it's still better than editing the zone files directly. :)

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, schema.html from the base documentation.

      +

      +


      +

      HISTORY

      +

      $Log: domain_record.html,v $ +

      Revision 1.1 2001-04-23 12:41:57 ivan +

      new API documentation +

      +Revision 1.1 2000/02/03 05:16:52 ivan +beginning of DNS and Apache support

      + + + + diff --git a/htdocs/docs/man/FS/nas.html b/htdocs/docs/man/FS/nas.html new file mode 100644 index 000000000..db704c777 --- /dev/null +++ b/htdocs/docs/man/FS/nas.html @@ -0,0 +1,117 @@ + + +FS::nas - Object methods for nas records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::nas - Object methods for nas records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::nas;
      +
      +  $record = new FS::nas \%hash;
      +  $record = new FS::nas {
      +    'nasnum'  => 1,
      +    'nasip'   => '10.4.20.23',
      +    'nasfqdn' => 'box1.brc.nv.us.example.net',
      +  };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +
      +  $error = $record->heartbeat($timestamp);
      +

      +


      +

      DESCRIPTION

      +

      An FS::nas object represents an Network Access Server on your network, such as +a terminal server or equivalent. FS::nas inherits from FS::Record. The +following fields are currently supported:

      +
      +
      nasnum - primary key
      +
      +
      nas - NAS name
      +
      +
      nasip - NAS ip address
      +
      +
      nasfqdn - NAS fully-qualified domain name
      +
      +
      last - timestamp indicating the last instant the NAS was in a known + state (used by the session monitoring).
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new NAS. To add the NAS to the database, see insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      check
      +
      +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. +

      +
      heartbeat TIMESTAMP
      +
      +Updates the timestamp for this nas +

      +

      +


      +

      VERSION

      +

      $Id: nas.html,v 1.1 2001-04-23 12:41:57 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/part_pkg.html b/htdocs/docs/man/FS/part_pkg.html new file mode 100644 index 000000000..4bf46742e --- /dev/null +++ b/htdocs/docs/man/FS/part_pkg.html @@ -0,0 +1,138 @@ + + +FS::part_pkg - Object methods for part_pkg objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::part_pkg - Object methods for part_pkg objects

      +

      +


      +

      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' );
      +

      +


      +

      DESCRIPTION

      +

      An FS::part_pkg object 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

      +
      +
      new HASHREF
      +
      +Creates a new billing item definition. To add the billing item definition to +the database, see insert. +

      +
      clone
      +
      +An alternate constructor. Creates a new billing item definition by duplicating +an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended +to the comment field. To add the billing item definition to the database, see +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. +

      +
      pkg_svc
      +
      +Returns all FS::pkg_svc objects (see the FS::pkg_svc manpage) for this package +definition (with non-zero quantity). +

      +
      svcpart [ SVCDB ]
      +
      +Returns the svcpart of a single service definition (see the FS::part_svc manpage) +associated with this billing item definition (see the FS::pkg_svc manpage). 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, +

      +

      +


      +

      VERSION

      +

      $Id: part_pkg.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      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, Safe. +schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/part_referral.html b/htdocs/docs/man/FS/part_referral.html new file mode 100644 index 000000000..61f49de04 --- /dev/null +++ b/htdocs/docs/man/FS/part_referral.html @@ -0,0 +1,100 @@ + + +FS::part_referral - Object methods for part_referral objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::part_referral - Object methods for part_referral objects

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Creates a new referral. To add the referral to the database, see 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. +

      +

      +


      +

      VERSION

      +

      $Id: part_referral.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      The delete method is unimplemented.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_main manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/part_svc.html b/htdocs/docs/man/FS/part_svc.html new file mode 100644 index 000000000..d5a521f5c --- /dev/null +++ b/htdocs/docs/man/FS/part_svc.html @@ -0,0 +1,110 @@ + + +FS::part_svc - Object methods for part_svc objects + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::part_svc - Object methods for part_svc objects

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Creates a new service definition. To add the service definition to the +database, see 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. +

      +

      +


      +

      VERSION

      +

      $Id: part_svc.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      Delete is unimplemented.

      +

      The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this +should be fixed.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::part_pkg manpage, the FS::pkg_svc manpage, the FS::cust_svc manpage, +the FS::svc_acct manpage, the FS::svc_acct_sm manpage, the FS::svc_domain manpage, schema.html from the +base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/pkg_svc.html b/htdocs/docs/man/FS/pkg_svc.html new file mode 100644 index 000000000..31592d4bd --- /dev/null +++ b/htdocs/docs/man/FS/pkg_svc.html @@ -0,0 +1,115 @@ + + +FS::pkg_svc - Object methods for pkg_svc records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::pkg_svc - Object methods for pkg_svc records

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Create a new record. To add the record to the database, see 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. +

      +
      part_pkg
      +
      +Returns the FS::part_pkg object (see the FS::part_pkg manpage). +

      +
      part_svc
      +
      +Returns the FS::part_svc object (see the FS::part_svc manpage). +

      +

      +


      +

      VERSION

      +

      $Id: pkg_svc.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::part_pkg manpage, the FS::part_svc manpage, schema.html from the base +documentation.

      + + + + diff --git a/htdocs/docs/man/FS/port.html b/htdocs/docs/man/FS/port.html new file mode 100644 index 000000000..b747f0ca3 --- /dev/null +++ b/htdocs/docs/man/FS/port.html @@ -0,0 +1,120 @@ + + +FS::port - Object methods for port records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::port - Object methods for port records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::port;
      +
      +  $record = new FS::port \%hash;
      +  $record = new FS::port { 'column' => 'value' };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +
      +  $session = $port->session;
      +

      +


      +

      DESCRIPTION

      +

      An FS::port object represents an individual port on a NAS. FS::port inherits +from FS::Record. The following fields are currently supported:

      +
      +
      portnum - primary key
      +
      +
      ip - IP address of this port
      +
      +
      nasport - port number on the NAS
      +
      +
      nasnum - NAS this port is on - see the FS::nas manpage
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new port. To add the example to the database, see insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      check
      +
      +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. +

      +
      session
      +
      +Returns the currently open session on this port, or if no session is currently +open, the most recent session. See the FS::session manpage. +

      +

      +


      +

      VERSION

      +

      $Id: port.html,v 1.1 2001-04-23 12:41:57 ivan Exp $

      +

      +


      +

      BUGS

      +

      The author forgot to customize this manpage.

      +

      The session method won't deal well if you have multiple open sessions on a +port, for example if your RADIUS server drops stop records. Suggestions for +how to deal with this sort of lossage welcome; should we close the session +when we get a new session on that port? Tag it as invalid somehow? Close it +one second after it was opened? *sigh* Maybe FS::session shouldn't let you +create overlapping sessions, at least folks will find out their logging is +dropping records.

      +

      If you think the above refers multiple user logins you need to read the +manpages again.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/prepay_credit.html b/htdocs/docs/man/FS/prepay_credit.html new file mode 100644 index 000000000..699b1c16f --- /dev/null +++ b/htdocs/docs/man/FS/prepay_credit.html @@ -0,0 +1,118 @@ + + +FS::prepay_credit - Object methods for prepay_credit records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::prepay_credit - Object methods for prepay_credit records

      +

      +


      +

      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;
      +

      +


      +

      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:

      +
      +
      field - description
      +
      +
      identifier - identifier entered by the user to receive the credit
      +
      +
      amount - amount of the credit
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new pre-paid credit. To add the example to the database, see +insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      check
      +
      +Checks all fields to make sure this is a valid pre-paid credit. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. +

      +

      +


      +

      VERSION

      +

      $Id: prepay_credit.html,v 1.1 2001-04-23 12:41:57 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, schema.html from the base documentation.

      +

      +


      +

      HISTORY

      +

      $Log: prepay_credit.html,v $ +

      Revision 1.1 2001-04-23 12:41:57 ivan +

      new API documentation +

      +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''

      + + + + diff --git a/htdocs/docs/man/FS/session.html b/htdocs/docs/man/FS/session.html new file mode 100644 index 000000000..c714337be --- /dev/null +++ b/htdocs/docs/man/FS/session.html @@ -0,0 +1,129 @@ + + +FS::session - Object methods for session records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::session - Object methods for session records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::session;
      +
      +  $record = new FS::session \%hash;
      +  $record = new FS::session {
      +    'portnum' => 1,
      +    'svcnum'  => 2,
      +    'login'   => $timestamp,
      +    'logout'  => $timestamp,
      +  };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +
      +  $error = $record->nas_heartbeat($timestamp);
      +

      +


      +

      DESCRIPTION

      +

      An FS::session object represents an user login session. FS::session inherits +from FS::Record. The following fields are currently supported:

      +
      +
      sessionnum - primary key
      +
      +
      portnum - NAS port for this session - see the FS::port manpage
      +
      +
      svcnum - User for this session - see the FS::svc_acct manpage
      +
      +
      login - timestamp indicating the beginning of this user session.
      +
      +
      logout - timestamp indicating the end of this user session. May be null, + which indicates a currently open session.
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new session. To add the session to the database, see insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. If the `login' field is empty, it is replaced with +the current time. +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. If the `logout' field is empty, +it is replaced with the current time. +

      +
      check
      +
      +Checks all fields to make sure this is a valid session. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. +

      +
      nas_heartbeat
      +
      +Heartbeats the nas associated with this session (see the FS::nas manpage). +

      +
      svc_acct
      +
      +Returns the svc_acct record associated with this session (see the FS::svc_acct manpage). +

      +

      +


      +

      VERSION

      +

      $Id: session.html,v 1.1 2001-04-23 12:41:57 ivan Exp $

      +

      +


      +

      BUGS

      +

      Maybe you shouldn't be able to insert a session if there's currently an open +session on that port. Or maybe the open session on that port should be flagged +as problematic? autoclosed? *sigh*

      +

      Hmm, sessions refer to current svc_acct records... probably need to constrain +deletions to svc_acct records such that no svc_acct records are deleted which +have a session (even if long-closed).

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/svc_Common.html b/htdocs/docs/man/FS/svc_Common.html new file mode 100644 index 000000000..7ce9ff36a --- /dev/null +++ b/htdocs/docs/man/FS/svc_Common.html @@ -0,0 +1,94 @@ + + +FS::svc_Common - Object method for all svc_ records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::svc_Common - Object method for all svc_ records

      +

      +


      +

      SYNOPSIS

      +

      use FS::svc_Common;

      +

      @ISA = qw( FS::svc_Common );

      +

      +


      +

      DESCRIPTION

      +

      FS::svc_Common is intended as a base class for table-specific classes to +inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record.

      +

      +


      +

      METHODS

      +
      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      The additional fields pkgnum and svcpart (see the FS::cust_svc manpage) should be +defined. An FS::cust_svc record will be created and inserted.

      +

      +
      delete
      +
      +Deletes this account from the database. If there is an error, returns the +error, otherwise returns false. +

      The corresponding FS::cust_svc record will be deleted as well.

      +

      +
      setfixed
      +
      +Sets any fixed fields for this service (see the FS::part_svc manpage). If there is an +error, returns the error, otherwise returns the FS::part_svc object (use ref() +to test the return). Usually called by the check method. +

      +
      setdefault
      +
      +Sets all fields to their defaults (see the FS::part_svc manpage), overriding their +current values. If there is an error, returns the error, otherwise returns +the FS::part_svc object (use ref() to test the return). +

      +
      suspend
      +
      +
      unsuspend
      +
      +
      cancel
      +
      +Stubs - return false (no error) so derived classes don't need to define these +methods. Called by the cancel method of FS::cust_pkg (see the FS::cust_pkg manpage). +

      +

      +


      +

      VERSION

      +

      $Id: svc_Common.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      The setfixed method return value.

      +

      The new method should set defaults from part_svc (like the check method +sets fixed values)?

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, schema.html +from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/svc_acct.html b/htdocs/docs/man/FS/svc_acct.html new file mode 100644 index 000000000..524fe3324 --- /dev/null +++ b/htdocs/docs/man/FS/svc_acct.html @@ -0,0 +1,219 @@ + + +FS::svc_acct - Object methods for svc_acct records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::svc_acct - Object methods for svc_acct records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::svc_acct;
      +
      +  $record = new FS::svc_acct \%hash;
      +  $record = new FS::svc_acct { 'column' => 'value' };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +
      +  $error = $record->suspend;
      +
      +  $error = $record->unsuspend;
      +
      +  $error = $record->cancel;
      +
      +  %hash = $record->radius;
      +

      +


      +

      DESCRIPTION

      +

      An FS::svc_acct object represents an account. FS::svc_acct inherits from +FS::svc_Common. 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

      +
      +
      new HASHREF
      +
      +Creates a new account. To add the account to the database, see 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(s) specified in +the shellmachine-useradd configuration are exectued on shellmachine via ssh. +This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true. +If the shellmachine-useradd configuration file does not exist,

      +
      +  useradd -d $dir -m -s $shell -u $uid $username
      +

      is the default. If the shellmachine-useradd configuration file exists but +it empty,

      +
      +  cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
      +

      is the default instead. Otherwise the contents of the file are treated as +a double-quoted perl string, with the following variables available: +$username, $uid, $gid, $dir, and $shell.

      +

      +
      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(s) specified in the shellmachine-userdel configuration file are +executed on shellmachine via ssh. This behavior can be surpressed by setting +$FS::svc_acct::nossh_hack true. If the shellmachine-userdel configuration +file does not exist,

      +
      +  userdel $username
      +

      is the default. If the shellmachine-userdel configuration file exists but +is empty,

      +
      +  rm -rf $dir
      +

      is the default instead. Otherwise the contents of the file are treated as a +double-quoted perl string, with the following variables available: +$username and $dir.

      +

      +
      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(s) specified in the shellmachine-usermod +configuraiton file are executed on shellmachine via ssh. This behavior can +be surpressed by setting $FS::svc-acct::nossh_hack true. If the +shellmachine-userdel configuration file does not exist or is empty, :

      +
      +  [ -d $old_dir ] && mv $old_dir $new_dir || (
      +    chmod u+t $old_dir;
      +    mkdir $new_dir;
      +    cd $old_dir;
      +    find . -depth -print | cpio -pdm $new_dir;
      +    chmod u-t $new_dir;
      +    chown -R $uid.$gid $new_dir;
      +    rm -rf $old_dir
      +  )
      +

      is executed on shellmachine via ssh. This behaviour can be surpressed by +setting $FS::svc_acct::nossh_hack true.

      +

      +
      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.

      +

      +
      radius
      +
      +Depriciated, use radius_reply instead. +

      +
      radius_reply
      +
      +Returns key/value pairs, suitable for assigning to a hash, for any RADIUS +reply attributes of this record. +

      Note that this is now the preferred method for reading RADIUS attributes - +accessing the columns directly is discouraged, as the column names are +expected to change in the future.

      +

      +
      radius_check
      +
      +Returns key/value pairs, suitable for assigning to a hash, for any RADIUS +check attributes of this record. +

      Accessing RADIUS attributes directly is not supported and will break in the +future.

      +

      +

      +


      +

      VERSION

      +

      $Id: svc_acct.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      The bits which ssh should fork before doing so (or maybe queue jobs for a +daemon).

      +

      The $recref stuff in sub check should be cleaned up.

      +

      The suspend, unsuspend and cancel methods update the database, but not the +current object. This is probably a bug as it's unexpected and +counterintuitive.

      +

      +


      +

      SEE ALSO

      +

      the FS::svc_Common manpage, the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc manpage, +the FS::part_svc manpage, the FS::cust_pkg manpage, the Net::SSH manpage, ssh, the FS::svc_acct_pop manpage, +schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/svc_acct_pop.html b/htdocs/docs/man/FS/svc_acct_pop.html new file mode 100644 index 000000000..e8c6f35d5 --- /dev/null +++ b/htdocs/docs/man/FS/svc_acct_pop.html @@ -0,0 +1,107 @@ + + +FS::svc_acct_pop - Object methods for svc_acct_pop records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::svc_acct_pop - Object methods for svc_acct_pop records

      +

      +


      +

      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;
      +

      +


      +

      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
      +
      +
      loc - rest of number
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new point of presence (if only it were that easy!). To add the +point of presence to the database, see insert. +

      +
      insert
      +
      +Adds this point of presence to the database. If there is an error, returns the +error, otherwise returns false. +

      +
      delete
      +
      +Removes this point of presence from the database. +

      +
      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. +

      +

      +


      +

      VERSION

      +

      $Id: svc_acct_pop.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      It should be renamed to part_pop.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the svc_acct manpage, schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/svc_acct_sm.html b/htdocs/docs/man/FS/svc_acct_sm.html new file mode 100644 index 000000000..1f513536d --- /dev/null +++ b/htdocs/docs/man/FS/svc_acct_sm.html @@ -0,0 +1,141 @@ + + +FS::svc_acct_sm - Object methods for svc_acct_sm records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::svc_acct_sm - Object methods for svc_acct_sm records

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Creates a new virtual mail alias. To add the virtual mail alias to the +database, see 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 dot-qmail/``EXTENSION ADDRESSES''). +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.

      +

      +

      +


      +

      VERSION

      +

      $Id: svc_acct_sm.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      The remote commands should be configurable.

      +

      The $recref stuff in sub check should be cleaned up.

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc manpage, the FS::part_svc manpage, the FS::cust_pkg manpage, +the FS::svc_acct manpage, the FS::svc_domain manpage, the Net::SSH manpage, ssh, dot-qmail, +schema.html from the base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/svc_domain.html b/htdocs/docs/man/FS/svc_domain.html new file mode 100644 index 000000000..5c75ab221 --- /dev/null +++ b/htdocs/docs/man/FS/svc_domain.html @@ -0,0 +1,162 @@ + + +FS::svc_domain - Object methods for svc_domain records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::svc_domain - Object methods for svc_domain records

      +

      +


      +

      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;
      +

      +


      +

      DESCRIPTION

      +

      An FS::svc_domain object represents a domain. FS::svc_domain inherits from +FS::svc_Common. The following fields are currently supported:

      +
      +
      svcnum - primary key (assigned automatically for new accounts)
      +
      +
      domain
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new domain. To add the domain to the database, see 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.

      +

      The additional field email can be used to manually set the admin contact +email address on this email. Otherwise, the svc_acct records for this package +(see the FS::cust_pkg manpage) are searched. If there is exactly one svc_acct record +in the same package, it is automatically used. Otherwise an error is returned.

      +

      If any soamachine configuration file exists, an SOA record is added to +the domain_record table (see <FS::domain_record>).

      +

      If any machines are defined in the nsmachines configuration file, NS +records are added to the domain_record table (see the FS::domain_record manpage).

      +

      If any machines are defined in the mxmachines configuration file, MX +records are added to the domain_record table (see the FS::domain_record manpage).

      +

      Any problems adding FS::domain_record records will emit warnings, but will +not return errors from this method. If your configuration files are correct +you shouln't have any problems.

      +

      +
      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
      +
      +Returns the Net::Whois::Domain object (see the Net::Whois manpage) 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.)

      +

      +
      _whois
      +
      +Depriciated. +

      +
      submit_internic
      +
      +Submits a registration email for this domain. +

      +

      +


      +

      VERSION

      +

      $Id: svc_domain.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      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.

      +

      +


      +

      SEE ALSO

      +

      the FS::svc_Common manpage, the FS::Record manpage, the FS::Conf manpage, the FS::cust_svc manpage, +the FS::part_svc manpage, the FS::cust_pkg manpage, the Net::Whois manpage, ssh, +dot-qmail, schema.html from the base documentation, config.html from the +base documentation.

      + + + + diff --git a/htdocs/docs/man/FS/svc_www.html b/htdocs/docs/man/FS/svc_www.html new file mode 100644 index 000000000..8f3a99a64 --- /dev/null +++ b/htdocs/docs/man/FS/svc_www.html @@ -0,0 +1,150 @@ + + +FS::svc_www - Object methods for svc_www records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::svc_www - Object methods for svc_www records

      +

      +


      +

      SYNOPSIS

      +
      +  use FS::svc_www;
      +
      +  $record = new FS::svc_www \%hash;
      +  $record = new FS::svc_www { 'column' => 'value' };
      +
      +  $error = $record->insert;
      +
      +  $error = $new_record->replace($old_record);
      +
      +  $error = $record->delete;
      +
      +  $error = $record->check;
      +
      +  $error = $record->suspend;
      +
      +  $error = $record->unsuspend;
      +
      +  $error = $record->cancel;
      +

      +


      +

      DESCRIPTION

      +

      An FS::svc_www object represents an web virtual host. FS::svc_www inherits +from FS::svc_Common. The following fields are currently supported:

      +
      +
      svcnum - primary key
      +
      +
      recnum - DNS `A' record corresponding to this web virtual host. (see the FS::domain_record manpage)
      +
      +
      usersvc - account (see the FS::svc_acct manpage) corresponding to this web virtual host.
      +
      +
      +

      +


      +

      METHODS

      +
      +
      new HASHREF
      +
      +Creates a new web virtual host. To add the record to the database, see +insert. +

      Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the hash method.

      +

      +
      insert
      +
      +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. +

      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) apachemachine, and +apacheroot exist, the command:

      +
      +  mkdir $apacheroot/$zone;
      +  chown $username $apacheroot/$zone;
      +  ln -s $apacheroot/$zone $homedir/$zone
      +

      $zone is the DNS A record pointed to by recnum +$username is the username pointed to by usersvc +$homedir is that user's home directory

      +

      is executed on apachemachine via ssh. This behaviour can be surpressed by +setting $FS::svc_www::nossh_hack true.

      +

      +
      delete
      +
      +Delete this record from the database. +

      +
      replace OLD_RECORD
      +
      +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. +

      +
      suspend
      +
      +Called by the suspend method of FS::cust_pkg (see the FS::cust_pkg manpage). +

      +
      unsuspend
      +
      +Called by the unsuspend method of FS::cust_pkg (see the FS::cust_pkg manpage). +

      +
      cancel
      +
      +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 example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and repalce methods. +

      +

      +


      +

      VERSION

      +

      $Id: svc_www.html,v 1.1 2001-04-23 12:41:57 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::svc_Common manpage, the FS::Record manpage, the FS::domain_record manpage, the FS::cust_svc manpage, +the FS::part_svc manpage, the FS::cust_pkg manpage, schema.html from the base documentation.

      +

      +


      +

      HISTORY

      +

      $Log: svc_www.html,v $ +

      Revision 1.1 2001-04-23 12:41:57 ivan +

      new API documentation +

      +Revision 1.4 2001/04/22 01:56:15 ivan +get rid of FS::SSH.pm (became Net::SSH and Net::SCP on CPAN)

      +

      Revision 1.3 2000/11/22 23:30:51 ivan +tyop

      +

      Revision 1.2 2000/03/01 08:13:59 ivan +compilation bugfixes

      +

      Revision 1.1 2000/02/03 05:16:52 ivan +beginning of DNS and Apache support

      + + + + diff --git a/htdocs/docs/man/FS/type_pkgs.html b/htdocs/docs/man/FS/type_pkgs.html new file mode 100644 index 000000000..30b052b81 --- /dev/null +++ b/htdocs/docs/man/FS/type_pkgs.html @@ -0,0 +1,100 @@ + + +FS::type_pkgs - Object methods for type_pkgs records + + + + + + + + + + + +
      +

      +

      NAME

      +

      FS::type_pkgs - Object methods for type_pkgs records

      +

      +


      +

      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;
      +

      +


      +

      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

      +
      +
      new HASHREF
      +
      +Create a new record. To add the record to the database, see 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. +

      +

      +


      +

      VERSION

      +

      $Id: type_pkgs.html,v 1.3 2001-04-23 12:40:31 ivan Exp $

      +

      +


      +

      BUGS

      +

      +


      +

      SEE ALSO

      +

      the FS::Record manpage, the FS::agent_type manpage, the FS::part_pkgs manpage, schema.html from the base +documentation.

      + + + + diff --git a/htdocs/docs/man/Invoice.txt b/htdocs/docs/man/Invoice.txt deleted file mode 100644 index 17953d51d..000000000 --- a/htdocs/docs/man/Invoice.txt +++ /dev/null @@ -1,23 +0,0 @@ -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 - diff --git a/htdocs/docs/man/Record.txt b/htdocs/docs/man/Record.txt deleted file mode 100644 index 0accb65d1..000000000 --- a/htdocs/docs/man/Record.txt +++ /dev/null @@ -1,332 +0,0 @@ -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 - diff --git a/htdocs/docs/man/SSH.txt b/htdocs/docs/man/SSH.txt deleted file mode 100644 index b6d205b55..000000000 --- a/htdocs/docs/man/SSH.txt +++ /dev/null @@ -1,63 +0,0 @@ -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 - diff --git a/htdocs/docs/man/UID.txt b/htdocs/docs/man/UID.txt deleted file mode 100644 index bf9f6b4bd..000000000 --- a/htdocs/docs/man/UID.txt +++ /dev/null @@ -1,79 +0,0 @@ -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 - diff --git a/htdocs/docs/man/agent.txt b/htdocs/docs/man/agent.txt deleted file mode 100644 index b0317f6f7..000000000 --- a/htdocs/docs/man/agent.txt +++ /dev/null @@ -1,65 +0,0 @@ -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 - diff --git a/htdocs/docs/man/agent_type.txt b/htdocs/docs/man/agent_type.txt deleted file mode 100644 index ea1edec0c..000000000 --- a/htdocs/docs/man/agent_type.txt +++ /dev/null @@ -1,72 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_bill.txt b/htdocs/docs/man/cust_bill.txt deleted file mode 100644 index 9762dd3ca..000000000 --- a/htdocs/docs/man/cust_bill.txt +++ /dev/null @@ -1,140 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_bill_pkg.txt b/htdocs/docs/man/cust_bill_pkg.txt deleted file mode 100644 index 1ca4b8cca..000000000 --- a/htdocs/docs/man/cust_bill_pkg.txt +++ /dev/null @@ -1,72 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_credit.txt b/htdocs/docs/man/cust_credit.txt deleted file mode 100644 index 84591ee81..000000000 --- a/htdocs/docs/man/cust_credit.txt +++ /dev/null @@ -1,75 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_main.txt b/htdocs/docs/man/cust_main.txt deleted file mode 100644 index df7848744..000000000 --- a/htdocs/docs/man/cust_main.txt +++ /dev/null @@ -1,200 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_main_county.txt b/htdocs/docs/man/cust_main_county.txt deleted file mode 100644 index 8e99397cc..000000000 --- a/htdocs/docs/man/cust_main_county.txt +++ /dev/null @@ -1,67 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_pay.txt b/htdocs/docs/man/cust_pay.txt deleted file mode 100644 index 9f28d0822..000000000 --- a/htdocs/docs/man/cust_pay.txt +++ /dev/null @@ -1,66 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_pkg.txt b/htdocs/docs/man/cust_pkg.txt deleted file mode 100644 index 5409083d8..000000000 --- a/htdocs/docs/man/cust_pkg.txt +++ /dev/null @@ -1,150 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_refund.txt b/htdocs/docs/man/cust_refund.txt deleted file mode 100644 index 392a0b57a..000000000 --- a/htdocs/docs/man/cust_refund.txt +++ /dev/null @@ -1,66 +0,0 @@ -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 - diff --git a/htdocs/docs/man/cust_svc.txt b/htdocs/docs/man/cust_svc.txt deleted file mode 100644 index d863ea852..000000000 --- a/htdocs/docs/man/cust_svc.txt +++ /dev/null @@ -1,72 +0,0 @@ -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 - diff --git a/htdocs/docs/man/dbdef.txt b/htdocs/docs/man/dbdef.txt deleted file mode 100644 index 6f1215a84..000000000 --- a/htdocs/docs/man/dbdef.txt +++ /dev/null @@ -1,80 +0,0 @@ -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 - diff --git a/htdocs/docs/man/dbdef_colgroup.txt b/htdocs/docs/man/dbdef_colgroup.txt deleted file mode 100644 index a7eebc6c7..000000000 --- a/htdocs/docs/man/dbdef_colgroup.txt +++ /dev/null @@ -1,51 +0,0 @@ -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 - diff --git a/htdocs/docs/man/dbdef_column.txt b/htdocs/docs/man/dbdef_column.txt deleted file mode 100644 index 93e239517..000000000 --- a/htdocs/docs/man/dbdef_column.txt +++ /dev/null @@ -1,69 +0,0 @@ -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 - diff --git a/htdocs/docs/man/dbdef_index.txt b/htdocs/docs/man/dbdef_index.txt deleted file mode 100644 index 8cf339b84..000000000 --- a/htdocs/docs/man/dbdef_index.txt +++ /dev/null @@ -1,27 +0,0 @@ -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 - diff --git a/htdocs/docs/man/dbdef_table.txt b/htdocs/docs/man/dbdef_table.txt deleted file mode 100644 index 25e010d8b..000000000 --- a/htdocs/docs/man/dbdef_table.txt +++ /dev/null @@ -1,94 +0,0 @@ -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 - diff --git a/htdocs/docs/man/dbdef_unique.txt b/htdocs/docs/man/dbdef_unique.txt deleted file mode 100644 index 0e4f0150b..000000000 --- a/htdocs/docs/man/dbdef_unique.txt +++ /dev/null @@ -1,27 +0,0 @@ -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 - diff --git a/htdocs/docs/man/index.html b/htdocs/docs/man/index.html deleted file mode 100644 index 4f33dd485..000000000 --- a/htdocs/docs/man/index.html +++ /dev/null @@ -1,48 +0,0 @@ - - Perl API - - -

      Perl API

      - -
      - -
      -
        -
      • FS::dbdef -
      • FS::dbdef_colgroup -
      • FS::dbdef_column -
      • FS::dbdef_index -
      • FS::dbdef_table -
      • FS::dbdef_unique - -
          - diff --git a/htdocs/docs/man/part_pkg.txt b/htdocs/docs/man/part_pkg.txt deleted file mode 100644 index dc1bce423..000000000 --- a/htdocs/docs/man/part_pkg.txt +++ /dev/null @@ -1,73 +0,0 @@ -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 - diff --git a/htdocs/docs/man/part_referral.txt b/htdocs/docs/man/part_referral.txt deleted file mode 100644 index 534996323..000000000 --- a/htdocs/docs/man/part_referral.txt +++ /dev/null @@ -1,63 +0,0 @@ -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 - diff --git a/htdocs/docs/man/part_svc.txt b/htdocs/docs/man/part_svc.txt deleted file mode 100644 index 680944e2f..000000000 --- a/htdocs/docs/man/part_svc.txt +++ /dev/null @@ -1,69 +0,0 @@ -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 - diff --git a/htdocs/docs/man/pkg_svc.txt b/htdocs/docs/man/pkg_svc.txt deleted file mode 100644 index bde0043f1..000000000 --- a/htdocs/docs/man/pkg_svc.txt +++ /dev/null @@ -1,61 +0,0 @@ -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 - diff --git a/htdocs/docs/man/svc_acct.txt b/htdocs/docs/man/svc_acct.txt deleted file mode 100644 index 1c9caf5fb..000000000 --- a/htdocs/docs/man/svc_acct.txt +++ /dev/null @@ -1,168 +0,0 @@ -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 - diff --git a/htdocs/docs/man/svc_acct_pop.txt b/htdocs/docs/man/svc_acct_pop.txt deleted file mode 100644 index ac0965413..000000000 --- a/htdocs/docs/man/svc_acct_pop.txt +++ /dev/null @@ -1,65 +0,0 @@ -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 - diff --git a/htdocs/docs/man/svc_acct_sm.txt b/htdocs/docs/man/svc_acct_sm.txt deleted file mode 100644 index e9940af9a..000000000 --- a/htdocs/docs/man/svc_acct_sm.txt +++ /dev/null @@ -1,121 +0,0 @@ -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 - diff --git a/htdocs/docs/man/svc_domain.txt b/htdocs/docs/man/svc_domain.txt deleted file mode 100644 index 03d3dbc27..000000000 --- a/htdocs/docs/man/svc_domain.txt +++ /dev/null @@ -1,131 +0,0 @@ -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 - diff --git a/htdocs/docs/man/type_pkgs.txt b/htdocs/docs/man/type_pkgs.txt deleted file mode 100644 index 9822b4802..000000000 --- a/htdocs/docs/man/type_pkgs.txt +++ /dev/null @@ -1,55 +0,0 @@ -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 - diff --git a/htdocs/docs/overview.dia b/htdocs/docs/overview.dia new file mode 100644 index 000000000..a0e34c30e Binary files /dev/null and b/htdocs/docs/overview.dia differ diff --git a/htdocs/docs/overview.png b/htdocs/docs/overview.png new file mode 100644 index 000000000..bf2dbc26c Binary files /dev/null and b/htdocs/docs/overview.png differ diff --git a/htdocs/docs/postgresql.html b/htdocs/docs/postgresql.html new file mode 100755 index 000000000..151081176 --- /dev/null +++ b/htdocs/docs/postgresql.html @@ -0,0 +1,23 @@ + + PostgreSQL notes + + +

          PostgreSQL notes

          +

          +PostgreSQL ships by default with a maximum of 31 character column names. If +you use arbitrary RADIUS attributes longer than 9 characters, fs-setup will +fail with `duplicate column' errors (in the part_svc table). +Solution: use a different database +engine, or recompile PostgreSQL with 64 character column names. +

          +Future versions of Freeside will keep all column names under 31 characters to +avoid this problem. +

          +

          +( I've personally been unable to get PostgreSQL working with larger column names, +though the process does look like it should be straightforward. If anyone is +interested in assisting me with this, please get in touch. + -Ivan <ivan@sisd.com> ) +

          + + diff --git a/htdocs/docs/schema.html b/htdocs/docs/schema.html index 5a296ec83..c06373b6b 100644 --- a/htdocs/docs/schema.html +++ b/htdocs/docs/schema.html @@ -17,30 +17,28 @@
        • typenum - primary key
        • atype - name of this agent type
        -
      • cust_bill - Invoices +
      • cust_bill - Invoices. Declarations that a customer owes you money. The specific charges are itemized in cust_bill_pkg.
        • invnum - primary key
        • custnum - customer
        • _date
        • charged - amount of this invoice -
        • owed - amount still outstanding on this invoice
        • printed - how many times this invoice has been printed automatically
      • cust_bill_pkg - Invoice line items
        • invnum - (multiple) key -
        • pkgnum - package +
        • pkgnum - package or 0 for the special virtual sales tax package
        • setup - setup fee
        • recur - recurring fee
        • sdate - starting date
        • edate - ending date
        -
      • cust_credit - Credits +
      • cust_credit - Credits. The equivalent of a negative cust_bill record.
        • crednum - primary key
        • custnum - customer
        • amount - amount credited -
        • credited - amount still outstanding (not yet refunded) on this credit
        • _date
        • otaker - order taker
        • reason @@ -50,7 +48,9 @@
        • custnum - primary key
        • agentnum - agent
        • refnum - referral +
        • titlenum - title
        • first - name +
        • middle - name
        • last - name
        • ss - social security number
        • company @@ -63,6 +63,7 @@
        • country
        • daytime - phone
        • night - phone +
        • fax - phone
        • payby - CARD, BILL, or COMP
        • payinfo - card number, P.O.#, or comp issuer
        • paydate - expiration date @@ -70,14 +71,21 @@
        • tax - tax exempt, Y or null
        • otaker - order taker
        +
      • cust_main_invoice - Invoice destinations for email invoices +
          +
        • destnum - primary key +
        • custnum - customer +
        • dest - Invoice destination: If numeric, a svcnum, if string, a literal email address, or `POST' to enable mailing (the default if no cust_main_invoice records exist) +
      • cust_main_county - Tax rates
        • taxnum - primary key
        • state
        • county +
        • country
        • tax - % rate
        -
      • cust_pay - Payments +
      • cust_pay - Payments. Money being transferred from a customer.
        • paynum - primary key
        • invnum - invoice @@ -117,7 +125,7 @@
        • cancel - (past) cancellation date
        • otaker - order taker
        -
      • cust_refund - Refunds +
      • cust_refund - Refunds. The transfer of money to a customer; equivalent to a negative cust_pay record. +
      • nas - Network Access Server (terminal server) +
          +
        • nasnum - primary key +
        • nas - NAS name +
        • nasip - NAS ip address +
        • nasfqdn - NAS fully-qualified domain name +
        • last - timestamp indicating the last instant the NAS was in a known state (used by the session monitoring). +
      • part_pkg - Package definitions
        • pkgpart - primary key @@ -144,8 +160,8 @@
      • part_referral - Referral listing
          -
        • refnum
        • - primary key -
        • referral
        • - referral +
        • refnum - primary key +
        • referral - referral
      • part_svc - Service definitions
          @@ -155,12 +171,39 @@
        • table__field - Default or fixed value for field in table
        • table__field_flag - null, D or F
        +
      • part_title - Personal titles +
          +
        • titlenum - primary key +
        • title - personal title (`Dr.' or `Mr.') +
      • pkg_svc +
      • port - individual port on a nas +
          +
        • portnum - primary key +
        • ip - IP address of this port +
        • nasport - port number on the NAS +
        • nasnum - NAS +
        +
      • prepay_credit +
          +
        • prepaynum - primary key +
        • identifier - text or numeric string used to receive this credit +
        • amount - amount of credit +
        +
      • session +
          +
        • sessionnum - primary key +
        • portnum - Port +
        • svcnum - Account +
        • login - timestamp indicating the beginning of this user session. +
        • logout - timestamp indicating the end of this user session. May be null, which indicates a currently open session. +
        +
      • svc_acct - Accounts
        • svcnum - primary key @@ -183,6 +226,7 @@
        • state
        • ac - area code
        • exch - exchange +
        • loc - rest of number
      • svc_acct_sm - Domain mail aliases +
      • domain_record - Domain zone detail +
          +
        • recnum - primary key +
        • svcnum - Domain (by svcnum) +
        • reczone - zone for this line +
        • recaf - address family, usually IN +
        • rectype - type for this record (A, MX, etc.) +
        • recdata - data for this record +
        +
      • svc_www +
      • type_pkgs
        • typenum - agent type diff --git a/htdocs/docs/session.html b/htdocs/docs/session.html new file mode 100644 index 000000000..7dac5fdf7 --- /dev/null +++ b/htdocs/docs/session.html @@ -0,0 +1,54 @@ + + Session monitor + + +

          Session monitor

          +

          Installation

          +For security reasons, the client portion of the session montior may run on one +or more external public machine(s). On these machines, install: +
            +
          • Perl (at l +east 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series. Don't enable experimental features like threads or the PerlIO abstraction layer.) +
          • FS::SessionClient (copy the fs_session/FS-SessionClient directory to the external machine, then: perl Makefile.PL; make; make install) +
          +Then: +
            +
          • Add the user `freeside' to the the external machine. +
          • Create the /usr/local/freeside directory on the external machine (owned by the freeside user). +
          • touch /usr/local/freeside/fs_sessiond_socket; chown freeside /usr/local/freeside/fs_sessiond_socket; chmod 600 /usr/local/freeside/fs_sessiond_socket +
          • Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the external machine(s). +
          • Run
            fs_session_server user machine
            on the Freeside machine. +
              +
            • user is a user from the mapsecrets file. +
            • machine is the name of the external machine. +
            +
          +

          Usage

          +
            +
          • Web +
              +
            • Copy FS-SessionClient/cgi/login.cgi and logout.cgi to your web + server's document space. +
            • Use suEXEC or setuid (see install.html for details) to run login.cgi and logout.cgi as the freeside user. +
            +
          • Command-line +
            freeside-login username ( portnum | ip | nasnum nasport )
            +freeside-logout username ( portnum | ip | nasnum nasport )
            +
              +
            • username is a customer username from the svc_acct table +
            • portnum, ip or nasport and nasnum uniquely identify a port in the port database table. +
            +
          • RADIUS +
              +
            • Configure your RADIUS server's login and logout callbacks to use the command-line freeside-login and freeside-logout utilites. +
            +
          +

          Callbacks

          +
            +
          • Sesstion start - The command(s) specified in the session-start configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: $ip, $nasip and $nasfqdn, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on. +
          • Session end - The command(s) specified in the session-stop configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: $ip, $nasip and $nasfqdn, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on. +
          +

          Dropping expired users

          +Run
          bin/freeside-session-kill username
          periodically from cron. + + diff --git a/htdocs/docs/signup.html b/htdocs/docs/signup.html new file mode 100644 index 000000000..a40b1f963 --- /dev/null +++ b/htdocs/docs/signup.html @@ -0,0 +1,57 @@ + + Signup server + + +

          Signup server

          +For security reasons, the signup server should run on an external public +webserver. On this machine, install: +
            +
          • A web server, such as Apache-SSL or Apache +
          • SSH +
          • Perl (at least 5.004_05 for the 5.004 series or 5.005_03 for the 5.005 series. Don't enable experimental features like threads or the PerlIO abstraction layer.) +
          • Text::Template +
          • HTTP::Headers::UserAgent (version 2.0 or higher; not yet indexed correctly on CPAN) + +
          • FS::SignupClient (copy the fs_signup/FS-SignupClient directory to the external machine, then: perl Makefile.PL; make; make install) +
          +Then: +
            +
          • Add the user `freeside' to the the external machine. +
          • Copy or symlink fs_signup/FS-SignupClient/cgi/signup.cgi into the web server's document space. +
          • Enable CGI execution for files with the `.cgi' extension. (with Apache) +
          • Create the /usr/local/freeside directory on the external machine (owned by the freeside user). +
          • touch /usr/local/freeside/fs_signupd_socket; chown freeside /usr/local/freeside/fs_signupd_socket; chmod 600 /usr/local/freeside/fs_signupd_socket +
          • Use suEXEC or setuid (see install.html for details) to run signup.cgi as the freeside user. +
          • Append the identity.pub from the freeside user on your freeside machine to the authorized_keys file of the newly created freeside user on the external machine(s). +
          • Run
            fs_signup_server user machine agentnum refnum
            on the Freeside machine. +
              +
            • user is a user from the mapsecrets file. +
            • machine is the name of the external machine. +
            • agentnum and refnum are the agent and referral, respectively, to use for customers who sign up via this signup server. +
            +
          +Optional: +
            +
          • If you create a /usr/local/freeside/ieak.template file on the external machine, it will be sent to IE users with MIME type application/x-Internet-signup. This file will be processed with Text::Template with the following variables available: +
              +
            • $ac - area code of selected POP +
            • $exch - exchange of selected POP +
            • $loc - local part of selected POP +
            • $username +
            • $password +
            • $email_name - first and last name +
            + (an example file is included as fs_signup/ieak.template) +
          • If you create a /usr/local/freeside/cck.template file on the external machine, the variables defined will be sent to Netscape users with MIME type application/x-netscape-autoconfigure-dialer-v2. This file will be processed with Text::Template with the following variables available: +
              +
            • $ac - area code of selected POP +
            • $exch - exchange of selected POP +
            • $loc - local part of selected POP +
            • $username +
            • $password +
            • $email_name - first and last name +
            + (an example file is included as fs_signup/cck.template). See the Netscape documentation for more information. +
          • If there are any entries in the prepay_credit table, a user can enter a string matching the identifier column to receive the credit specified in the amount column, and/or the time specified in the seconds column (for use with the session monitor), after which that identifier is no longer valid. This can be used to implement pre-paid "calling card" type signups. The bin/generate-prepay script can be used to populate the prepay_credit table. +
          + diff --git a/htdocs/docs/trouble.html b/htdocs/docs/trouble.html index 2cf6d4e71..fce743928 100644 --- a/htdocs/docs/trouble.html +++ b/htdocs/docs/trouble.html @@ -5,11 +5,6 @@

          Troubleshooting

          • When troubleshooting the web interface, helpful information is often in your web server's error log. -
          • Internet Explorer will not work with Freeside's HTML interface. -Netscape, -Lynx, and -Emacs/W3, -among others, should work fine.
          • 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.
          • If you get tons of errors in your web server's error log like this:
            @@ -17,13 +12,6 @@ Ambiguous use of value => resolved to "value" =>
             at /usr/lib/perl5/site_perl/File/CounterFile.pm line 132.
             
            This clutters up your log files but is otherwise harmless. Upgrade to the latest File::CounterFile. -
          • 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: -
            -access to /your/path/edit/process/some_table.cgi failed for
            -machine.domain.tld, reason: malformed header from script.
            -Bad header=HTTP/1.0 302 Moved Temporarily
            -
            - Then you forgot to apply this patch as mentioned in the New Installation section of the documentation.
          • If you get errors like this:
             UID.pm: Can't open /var/spool/freeside/conf/secrets: Permission denied 
            @@ -31,11 +19,8 @@ at /your/path/site_perl/FS/UID.pm line 26.
             BEGIN failed--compilation aborted at
             /your/path/edit/process/part_svc.cgi line 15.
             
            - 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 New Installation section of the documentation, set ownership and permissions for the web interface. Your system should support secure setuid scripts or Perl's emulation, see perlsec: Security Bugs for information and workarounds. -
            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
            + Then the scripts are not running as the freeside freeside user. See +the New Installation section of the documentation. +
          • If you receive `can not connect to server' errors using MySQL on a system that doesn't support native threading, you may need to specify the full hostname in your DBI datasource. See the MySQL documentation, DBI manpage and the DBD::mysql manpage for details.
          diff --git a/htdocs/docs/upgrade2.html b/htdocs/docs/upgrade2.html index 4bf7ea45a..7acae48f7 100644 --- a/htdocs/docs/upgrade2.html +++ b/htdocs/docs/upgrade2.html @@ -1,8 +1,8 @@ - Upgrading to 1.1.3 + Upgrading to 1.1.4 -

          Upgrading to 1.1.3 from 1.1.x

          +

          Upgrading to 1.1.4 from 1.1.x

          • If migrating from 1.0.0, see these instructions first.
          • Back up your data and current Freeside installation. diff --git a/htdocs/docs/upgrade3.html b/htdocs/docs/upgrade3.html new file mode 100644 index 000000000..0837e0207 --- /dev/null +++ b/htdocs/docs/upgrade3.html @@ -0,0 +1,40 @@ + + Upgrading to 1.2.x + + +

            Upgrading to 1.2.x from 1.1.x

            +
              +
            • If migrating from 1.0.0, see these instructions first. +
            • If migrating from less than 1.1.4, see these instructions first. +
            • Back up your data and current Freeside installation. +
            • Install the Perl module String-Approx +
            • Configuration file location has changed! +
            • Move /var/spool/freeside/dbdef.datasrc to /usr/local/etc/freeside/dbdef.datasrc. +
            • Move /var/spool/freeside/counters to /usr/local/etc/freeside/counters.datasrc. +
            • Move /var/spool/freeside/export to /usr/local/etc/freeside/export.datasrc. +
            • Apply the following changes to your database: +
              +ALTER TABLE cust_main CHANGE state state varchar(80) NULL;
              +ALTER TABLE cust_main_county CHANGE state state varchar(80) NULL;
              +ALTER TABLE cust_main_county ADD country char(2);
              +ALTER TABLE cust_main CHANGE paydate paydate varchar(10);
              +UPDATE cust_main SET country = "US" where country IS NULL OR country = '';
              +UPDATE cust_main_county SET country = "US" where country IS NULL OR country = "";
              +CREATE TABLE cust_main_invoice (
              +   destnum int NOT NULL,
              +   custnum int NOT NULL,
              +   dest varchar(80) NOT NULL,
              +   PRIMARY KEY (destnum),
              +   INDEX ( custnum )
              +);
              +
              +
            • 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. +
            • Copy or symlink htdocs and site_perl to the new copies. + diff --git a/htdocs/docs/upgrade4.html b/htdocs/docs/upgrade4.html new file mode 100644 index 000000000..1d70f8b73 --- /dev/null +++ b/htdocs/docs/upgrade4.html @@ -0,0 +1,27 @@ + + Upgrading to 1.2.2 + + +

              Upgrading to 1.2.2 from 1.2.x

              +
                +
              • If migrating from 1.0.0, see these instructions first. +
              • If migrating from less than 1.1.4, see these instructions first. +
              • If migrating from less than 1.2.0, see these instructions first. +
              • Back up your data and current Freeside installation. +
              • Install the Perl modules Locale-Codes and Net-Whois. +
              • Apply the following changes to your database: +
                +ALTER TABLE cust_pay_batch CHANGE exp exp VARCHAR(11);
                +
                +
              • Copy or symlink htdocs to the new copy. +
              • Remove the symlink or directory (your_site_perl_directory)/FS. +
              • Change to the FS directory in the new tarball, and build and install the + Perl modules: +
                +$ cd FS/
                +$ perl Makefile.PL
                +$ make
                +$ su
                +# make install
                +
              • 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. + diff --git a/htdocs/docs/upgrade5.html b/htdocs/docs/upgrade5.html new file mode 100644 index 000000000..3f3431653 --- /dev/null +++ b/htdocs/docs/upgrade5.html @@ -0,0 +1,34 @@ + + Upgrading to 1.3.0 + + +

                Upgrading to 1.2.3 from 1.2.2

                +
                  +
                • If migrating from 1.0.0, see these instructions first. +
                • If migrating from less than 1.1.4, see these instructions first. +
                • If migrating from less than 1.2.0, see these instructions first. +
                • If migrating from less than 1.2.2, see these instructions first. +
                • Back up your data and current Freeside installation. +
                • Apply the following changes to your database: +
                  +ALTER TABLE svc_acct_pop ADD loc CHAR(4);
                  +CREATE TABLE prepay_credit (
                  +  prepaynum int NOT NULL,
                  +  identifier varchar(80) NOT NULL,
                  +  amount decimal(10,2) NOT NULL,
                  +  PRIMARY KEY (prepaynum),
                  +  INDEX (identifier)
                  +);
                  +
                  +
                • Copy or symlink htdocs to the new copy. +
                • Remove the symlink or directory (your_site_perl_directory)/FS. +
                • Change to the FS directory in the new tarball, and build and install the + Perl modules: +
                  +$ cd FS/
                  +$ perl Makefile.PL
                  +$ make
                  +$ su
                  +# make install
                  +
                • 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. + diff --git a/htdocs/docs/upgrade6.html b/htdocs/docs/upgrade6.html new file mode 100644 index 000000000..6758bd511 --- /dev/null +++ b/htdocs/docs/upgrade6.html @@ -0,0 +1,66 @@ + + Upgrading to 1.3.0 + + +

                  Upgrading to 1.3.0 from 1.2.3

                  +
                    +
                  • If migrating from 1.0.0, see these instructions first. +
                  • If migrating from less than 1.1.4, see these instructions first. +
                  • If migrating from less than 1.2.0, see these instructions first. +
                  • If migrating from less than 1.2.2, see these instructions first. +
                  • If migrating from less than 1.2.3, see these instructions first. +
                  • Back up your data and current Freeside installation. +
                  • As 1.3.0 requires transactions, MySQL's default MyISAM and ISAM table types are no longer supported. Converting to PostgreSQL is recommended. If you really want to use MySQL, convert your tables to one of the transaction-safe table types such as BDB. +
                  • Copy the invoice_template file from the conf/ directory in the distribution to your configuration directory. +
                  • Install the Text-Template, DBIx-DBSchema, Net-SSH and Net-SCP Perl modules. +
                  • Apply the following changes to your database: +
                    +CREATE TABLE domain_record (
                    +  recnum int NOT NULL,
                    +  svcnum int NOT NULL,
                    +  reczone varchar(80) NOT NULL,
                    +  recaf char(2) NOT NULL,
                    +  rectype char(5) NOT NULL,
                    +  recdata varchar(80) NOT NULL,
                    +  PRIMARY KEY (recnum)
                    +);
                    +CREATE TABLE svc_www (
                    +  svcnum int NOT NULL,
                    +  recnum int NOT NULL,
                    +  usersvc int NOT NULL,
                    +  PRIMARY KEY (svcnum)
                    +);
                    +ALTER TABLE part_svc ADD svc_www__recnum varchar(80) NULL;
                    +ALTER TABLE part_svc ADD svc_www__recnum_flag char(1) NULL;
                    +ALTER TABLE part_svc ADD svc_www__usersvc varchar(80) NULL;
                    +ALTER TABLE part_svc ADD svc_www__uesrsvc_flag char(1) NULL;
                    +ALTER TABLE svc_acct CHANGE _password _password varchar(50) NULL;
                    +ALTER TABLE svc_acct ADD seconds integer NULL;
                    +ALTER TABLE part_svc ADD svc_acct__seconds integer NULL;
                    +ALTER TABLE part_svc ADD svc_acct__seconds_flag char(1) NULL;
                    +ALTER TABLE prepay_credit ADD seconds integer NULL;
                    +
                    +
                    +
                  • If your database supports dropping columns: +
                    +ALTER TABLE cust_bill DROP owed;
                    +ALTER TABLE cust_credit DROP credited;
                    +
                    + Or, if your database does not support dropping columns, you can do this: +
                    +ALTER TABLE cust_bill CHANGE owed depriciated decimal(10,2);
                    +ALTER TABLE cust_credit CHANGE credited depriciated2 decimal(10,2);
                    +
                    + +
                  • Copy or symlink htdocs to the new copy. +
                  • Remove the symlink or directory (your_site_perl_directory)/FS. +
                  • Change to the FS directory in the new tarball, and build and install the + Perl modules: +
                    +$ cd FS/
                    +$ perl Makefile.PL
                    +$ make
                    +$ su
                    +# make install
                    +
                  • Run bin/dbdef-create. + diff --git a/htdocs/edit/agent.cgi b/htdocs/edit/agent.cgi index 5bd116528..5b42095b3 100755 --- a/htdocs/edit/agent.cgi +++ b/htdocs/edit/agent.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# agent.cgi: Add/Edit agent (output form) +# $Id: agent.cgi,v 1.7 1999-04-07 11:27:50 ivan Exp $ # # ivan@sisd.com 97-dec-12 # @@ -9,38 +9,70 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: agent.cgi,v $ +# Revision 1.7 1999-04-07 11:27:50 ivan +# avoid perl's silly arguement not numeric error +# +# Revision 1.6 1999/01/25 12:09:50 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:31 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:21 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:16:57 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/23 07:52:08 ivan +# *** empty log message *** +# use strict; -use CGI::Base; +use vars qw ( $cgi $agent $action $hashref $p $agent_type ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(header menubar popurl); +use FS::Record qw(qsearch qsearchs fields); use FS::agent; -use FS::CGI qw(header menubar); +use FS::agent_type; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($agent,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $agent=qsearchs('agent',{'agentnum'=>$1}); - $action='Edit'; +if ( $cgi->param('error') ) { + $agent = new FS::agent ( { + map { $_, scalar($cgi->param($_)) } fields('agent') + } ); +} elsif ( $cgi->keywords ) { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $agent = qsearchs( 'agent', { 'agentnum' => $1 } ); } else { #adding - $agent=create FS::agent {}; - $action='Add'; + $agent = new FS::agent {}; } -my($hashref)=$agent->hashref; +$action = $agent->agentnum ? 'Edit' : 'Add'; +$hashref = $agent->hashref; + +$p = popurl(2); + +print $cgi->header( '-expires' => 'now' ), header("$action Agent", menubar( + 'Main Menu' => $p, + 'View all agents' => $p. 'browse/agent.cgi', +)); -print header("$action Agent", menubar( - 'Main Menu' => '../', - 'View all agents' => '../browse/agent.cgi', -)), '
                    '; +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -print qq!!, +print '', + qq!!, "Agent #", $hashref->{agentnum} ? $hashref->{agentnum} : "(NEW)"; print < END -my($agent_type); foreach $agent_type (qsearch('agent_type',{})) { - print "{typenum} == $agent_type->getfield('typenum'); + if $hashref->{typenum} && ( $hashref->{typenum} == $agent_type->typenum ); print ">", $agent_type->getfield('typenum'), ": ", $agent_type->getfield('atype'),"\n"; } diff --git a/htdocs/edit/agent_type.cgi b/htdocs/edit/agent_type.cgi index b9fff4530..bdf64c58f 100755 --- a/htdocs/edit/agent_type.cgi +++ b/htdocs/edit/agent_type.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: agent_type.cgi,v 1.11 1999-04-07 11:19:21 ivan Exp $ +# # agent_type.cgi: Add/Edit agent type (output form) # # ivan@sisd.com 97-dec-10 @@ -9,46 +11,91 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: agent_type.cgi,v $ +# Revision 1.11 1999-04-07 11:19:21 ivan +# silly HTML typo +# +# Revision 1.10 1999/01/25 12:09:51 ivan +# yet more mod_perl stuff +# +# Revision 1.9 1999/01/19 05:13:32 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.8 1999/01/18 09:41:22 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.7 1999/01/18 09:22:29 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.6 1998/12/17 06:16:58 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.5 1998/11/21 07:58:27 ivan +# package names link to them +# +# Revision 1.4 1998/11/21 07:45:19 ivan +# visual, use FS::table_name when doing qsearch('table_name') +# +# Revision 1.3 1998/11/15 11:20:12 ivan +# s/CGI-Base/CGI.pm/ causes s/QUERY_STRING/keywords/; +# +# Revision 1.2 1998/11/13 09:56:46 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base; +use vars qw( $cgi $agent_type $action $hashref $p $part_pkg ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::agent_type; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); +use FS::agent_type; +use FS::part_pkg; +use FS::type_pkgs; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($agent_type,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $agent_type = new FS::agent_type ( { + map { $_, scalar($cgi->param($_)) } fields('agent') + } ); +} elsif ( $cgi->keywords ) { #editing + my( $query ) = $cgi->keywords; + $query =~ /^(\d+)$/; $agent_type=qsearchs('agent_type',{'typenum'=>$1}); - $action='Edit'; } else { #adding - $agent_type=create FS::agent_type {}; - $action='Add'; + $agent_type = new FS::agent_type {}; } -my($hashref)=$agent_type->hashref; +$action = $agent_type->typenum ? 'Edit' : 'Add'; +$hashref = $agent_type->hashref; + +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Agent Type", menubar( + 'Main Menu' => "$p", + 'View all agent types' => "${p}browse/agent_type.cgi", +)); -print header("$action Agent Type", menubar( - 'Main Menu' => '../', - 'View all agent types' => '../browse/agent_type.cgi', -)), ''; +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -print qq!!, +print '', + qq!!, "Agent Type #", $hashref->{typenum} ? $hashref->{typenum} : "(NEW)"; print <Type -

                    Select which packages agents of this type may sell to customers

                    +

                    Agent Type +

                    Select which packages agents of this type may sell to customers
                    END -my($part_pkg); foreach $part_pkg ( qsearch('part_pkg',{}) ) { print qq!
                    !,$part_pkg->getfield('pkg') + qq!VALUE="ON"> !, + qq!', $part_pkg->getfield('pkg'), '', ; } diff --git a/htdocs/edit/cust_credit.cgi b/htdocs/edit/cust_credit.cgi index 75ef21208..35c4d48fe 100755 --- a/htdocs/edit/cust_credit.cgi +++ b/htdocs/edit/cust_credit.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_credit.cgi: Add a credit (output form) +# $Id: cust_credit.cgi,v 1.7 1999-02-28 00:03:33 ivan Exp $ # # Usage: cust_credit.cgi custnum [ -paybatch ] # http://server.name/path/cust_credit?custnum [ -paybatch ] # -# Note: Should be run setuid root as user nobody. -# # some hooks in here for modifications as well as additions, but needs (lots) more work. # also see process/cust_credit.cgi, the script that processes the form. # @@ -23,63 +21,89 @@ # ivan@voicenet.com 97-apr-21 # # rewrite ivan@sisd.com 98-mar-16 +# +# $Log: cust_credit.cgi,v $ +# Revision 1.7 1999-02-28 00:03:33 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:09:52 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:33 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:23 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/23 02:26:06 ivan +# *** empty log message *** +# +# Revision 1.2 1998/12/17 06:16:59 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; +use vars qw( $cgi $query $custnum $otaker $p1 $crednum $_date $amount $reason ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); #CGI module +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw(header popurl); +use FS::Record qw(fields); +#use FS::cust_credit; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint custnum -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; - -#untaint otaker -my($otaker)=getotaker; - -SendHeaders(); # one guess. +if ( $cgi->param('error') ) { + #$cust_credit = new FS::cust_credit ( { + # map { $_, scalar($cgi->param($_)) } fields('cust_credit') + #} ); + $custnum = $cgi->param('custnum'); + $amount = $cgi->param('amount'); + #$refund = $cgi->param('refund'); + $reason = $cgi->param('reason'); +} else { + ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + $amount = ''; + #$refund = 'yes'; + $reason = ''; +} +$_date = time; + +$otaker = getotaker; + +$p1 = popurl(1); + +print $cgi->header( '-expires' => 'now' ), header("Post Credit", ''); +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); print < - - Post Credit - - -
                    -

                    Post Credit

                    -
                    - -
                    +    
                    +    
                     END
                     
                    -#crednum
                    -my($crednum)="";
                    +$crednum = "";
                     print qq!Credit #!, $crednum ? $crednum : " (NEW)", qq!!;
                     
                    -#custnum
                     print qq!\nCustomer #$custnum!;
                     
                    -#paybatch
                     print qq!!;
                     
                    -#date
                    -my($date)=time;
                    -print qq!\nDate: !, time2str("%D",$date), qq!!;
                    +print qq!\nDate: !, time2str("%D",$_date), qq!!;
                     
                    -#amount
                    -my($amount)='';
                     print qq!\nAmount \$!;
                    +print qq!!;
                     
                    -#refund?
                    -#print qq! Also post refund!;
                    +#print qq! Also post refund!;
                     
                    -#otaker (hidden)
                     print qq!!;
                     
                    -#reason
                    -my($reason)='';
                     print qq!\nReason !;
                     
                     print < 96-dec-04
                     #
                     # Blank custnum for new customer.
                    @@ -38,82 +36,268 @@
                     #	bmccane@maxbaud.net	98-apr-3
                     #
                     # fixed one missed day->daytime ivan@sisd.com 98-jul-13
                    +#
                    +# $Log: cust_main.cgi,v $
                    +# Revision 1.28  2000-12-26 23:51:40  ivan
                    +# statedefault & referraldefault config files
                    +#
                    +# Revision 1.27  2000/12/03 13:45:15  ivan
                    +# patch from Jason Spence : admin.html doc, autocapgen
                    +#
                    +# Revision 1.26  2000/06/27 12:15:50  ivan
                    +# i18n
                    +#
                    +# Revision 1.25  2000/03/02 08:09:38  ivan
                    +# still need to allow blank expiration dates
                    +#
                    +# Revision 1.24  2000/01/30 06:54:50  ivan
                    +# credit card expiration dates not sticky bug fixed?
                    +#
                    +# Revision 1.23  2000/01/27 00:53:14  ivan
                    +# 5.004_04 workaround
                    +#
                    +# Revision 1.22  1999/12/17 02:33:23  ivan
                    +# argh
                    +#
                    +# Revision 1.21  1999/08/23 07:40:38  ivan
                    +# missing  flag
                    +#
                    +# Revision 1.20  1999/08/23 07:08:11  ivan
                    +# no CGI::Switch for now
                    +#
                    +# Revision 1.19  1999/08/21 02:14:25  ivan
                    +# better error message for no agents
                    +#
                    +# Revision 1.18  1999/08/11 15:38:33  ivan
                    +# fix for perl 5.004_04
                    +#
                    +# Revision 1.17  1999/08/10 11:15:45  ivan
                    +# corrected a misleading comment
                    +#
                    +# Revision 1.15  1999/04/14 13:14:54  ivan
                    +# configuration option to edit referrals of existing customers
                    +#
                    +# Revision 1.14  1999/04/14 07:47:53  ivan
                    +# i18n fixes
                    +#
                    +# Revision 1.13  1999/04/09 03:52:55  ivan
                    +# explicit & for table/itable/ntable
                    +#
                    +# Revision 1.12  1999/04/06 11:16:16  ivan
                    +# give a meaningful error message if you try to create a customer before you've
                    +# created an agent
                    +#
                    +# Revision 1.11  1999/03/25 13:55:10  ivan
                    +# one-screen new customer entry (including package and service) for simple
                    +# packages with one svc_acct service
                    +#
                    +# Revision 1.10  1999/02/28 00:03:34  ivan
                    +# removed misleading comments
                    +#
                    +# Revision 1.9  1999/02/23 08:09:20  ivan
                    +# beginnings of one-screen new customer entry and some other miscellania
                    +#
                    +# Revision 1.8  1999/01/25 12:09:53  ivan
                    +# yet more mod_perl stuff
                    +#
                    +# Revision 1.7  1999/01/19 05:13:34  ivan
                    +# for mod_perl: no more top-level my() variables; use vars instead
                    +# also the last s/create/new/;
                    +#
                    +# Revision 1.6  1999/01/18 09:41:24  ivan
                    +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
                    +# (good idea anyway)
                    +#
                    +# Revision 1.5  1999/01/18 09:22:30  ivan
                    +# changes to track email addresses for email invoicing
                    +#
                    +# Revision 1.4  1998/12/23 08:08:15  ivan
                    +# fix typo
                    +#
                    +# Revision 1.3  1998/12/17 06:17:00  ivan
                    +# fix double // in relative URLs, s/CGI::Base/CGI/;
                    +#
                     
                     use strict;
                    -use CGI::Base;
                    +use vars qw( $cgi $custnum $action $cust_main $p1 @agents $agentnum 
                    +             $last $first $ss $company $address1 $address2 $city $zip 
                    +             $daytime $night $fax @invoicing_list $invoicing_list $payinfo
                    +             $payname %payby %paybychecked $refnum $otaker $r );
                    +use vars qw ( $conf $pkgpart $username $password $popnum $ulen $ulen2 );
                    +#use CGI::Switch;
                    +use CGI;
                     use CGI::Carp qw(fatalsToBrowser);
                     use FS::UID qw(cgisuidsetup getotaker);
                    -use FS::Record qw(qsearch qsearchs);
                    +#use FS::Record qw(qsearch qsearchs fields);
                    +use FS::Record qw(qsearch qsearchs fields dbdef);
                    +use FS::CGI qw(header popurl itable table);
                     use FS::cust_main;
                    +use FS::agent;
                    +use FS::part_referral;
                    +use FS::cust_main_county;
                    +
                    +  #for misplaced logic below
                    +  use FS::part_pkg;
                     
                    -my($cgi) = new CGI::Base;
                    -$cgi->get;
                    +  #for false laziness below
                    +  use FS::svc_acct_pop;
                     
                    +  #for (other) false laziness below
                    +  use FS::agent;
                    +  use FS::type_pkgs;
                    +
                    +$cgi = new CGI;
                     cgisuidsetup($cgi);
                     
                    -SendHeaders(); # one guess.
                    +$conf = new FS::Conf;
                     
                     #get record
                    -my($custnum,$action,$cust_main);
                    -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing
                    +
                    +if ( $cgi->param('error') ) {
                    +  $cust_main = new FS::cust_main ( {
                    +    map { $_, scalar($cgi->param($_)) } fields('cust_main')
                    +  } );
                    +  $custnum = $cust_main->custnum;
                    +  $pkgpart = $cgi->param('pkgpart_svcpart') || '';
                    +  if ( $pkgpart =~ /^(\d+)_/ ) {
                    +    $pkgpart = $1;
                    +  } else {
                    +    $pkgpart = '';
                    +  }
                    +  $username = $cgi->param('username');
                    +  $password = $cgi->param('_password');
                    +  $popnum = $cgi->param('popnum');
                    +} elsif ( $cgi->keywords ) { #editing
                    +  my( $query ) = $cgi->keywords;
                    +  $query =~ /^(\d+)$/;
                       $custnum=$1;
                    -  $cust_main = qsearchs('cust_main',{'custnum'=>$custnum});
                    -  $action='Edit';
                    +  $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } );
                    +  $pkgpart = 0;
                    +  $username = '';
                    +  $password = '';
                    +  $popnum = 0;
                     } else {
                       $custnum='';
                    -  $cust_main = create FS::cust_main ( {} );
                    +  $cust_main = new FS::cust_main ( {} );
                       $cust_main->setfield('otaker',&getotaker);
                    -  $cust_main->setfield('country','US');
                    -  $action='Add';
                    +  $pkgpart = 0;
                    +  $username = '';
                    +  $password = '';
                    +  $popnum = 0;
                     }
                    -
                    -print <
                    -  
                    -    Customer $action
                    -  
                    -  
                    -    
                    -

                    Customer $action

                    -
                    - -
                    +$action = $custnum ? 'Edit' : 'Add';
                    +
                    +# top
                    +
                    +$p1 = popurl(1);
                    +print $cgi->header( '-expires' => 'now' ), header("Customer $action", '');
                    +print qq!Error: !, $cgi->param('error'),
                    +      ""
                    +  if $cgi->param('error');
                    +
                    +# JRS: Javascript to set up the form for us
                    +    if ( $conf->exists('autocapnames') ) {
                    +      print <
                    +
                     END
                    +}
                    +
                    +print qq!!,
                    +      qq!!,
                    +      qq!Customer # !, ( $custnum ? $custnum : " (NEW)" ),
                    +      
                    +;
                    +
                    +# agent
                    +
                    +$r = qq!*!;
                     
                    -print qq!!,
                    -      qq!Customer #!;
                    -print $custnum ? $custnum : " (NEW)" , "";
                    -
                    -#agentnum
                    -my($agentnum)=$cust_main->agentnum || 1; #set to first agent by default
                    -my(@agents) = qsearch('agent',{});
                    -print qq!\n\nAgent # !;
                    +} else {
                    +  print qq!

                    ${r}Agent "; } -print ""; #referral -#unless ($custnum) { - my($refnum)=$cust_main->refnum || 0; #to avoid "arguement not numeric" error + +$refnum = $cust_main->refnum || $conf->config('referraldefault') || 0; +if ( $custnum && ! $conf->exists('editreferrals') ) { + print qq!!; +} else { my(@referrals) = qsearch('part_referral',{}); - print qq!\nReferral !; + } else { + print qq!

                    ${r}Referral "; } - print ""; -#} +} + -my($last,$first,$ss,$company,$address1,$address2,$city)=( +# contact info + +($last,$first,$ss,$company,$address1,$address2,$city,$zip)=( $cust_main->last, $cust_main->first, $cust_main->ss, @@ -121,94 +305,209 @@ my($last,$first,$ss,$company,$address1,$address2,$city)=( $cust_main->address1, $cust_main->address2, $cust_main->city, + $cust_main->zip, ); -print <
                    Contact information", &itable("#c0c0c0"), <${r}Contact name
                    (last, first) +END +if ( $conf->exists('autocapnames') ) { + print <, + +END +} else { + print <, + +END +} -Name (last) (first) SS# -Company -Address - -City State (county) +Company +${r}Address +${r}City${r}State/Country"; +print qq!${r}Zip!; -my($zip,$country,$daytime,$night,$fax)=( - $cust_main->zip, - $cust_main->country, +($daytime,$night,$fax)=( $cust_main->daytime, $cust_main->night, $cust_main->fax, ); print < -Country: $country +Day Phone +Night Phone +Fax +END -Phone (daytime) (night) (fax) +print "$r required fields
                    "; + +# billing info + +sub expselect { + my $prefix = shift; + my( $m, $y ) = (0, 0); + if ( scalar(@_) ) { + my $date = shift || '01-2000'; + if ( $date =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #PostgreSQL date format + ( $m, $y ) = ( $2, $1 ); + } elsif ( $date =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $m, $y ) = ( $1, $3 ); + } else { + die "unrecognized expiration date format: $date"; + } + } -END + my $return = qq!!; + for ( 2001 .. 2037 ) { + $return .= " "Credit card ", - 'BILL' => "Billing ", - 'COMP' => "Complimentary", -); -for (qw(CARD BILL COMP)) { - print qq!payby eq "$_"); - print qq!>$payby{$_}!; + $return; } - -my($payinfo,$payname,$otaker)=( +print "
                    Billing information", &itable("#c0c0c0"), + qq!tax eq "Y"; +print qq!>Tax Exempt!; +print qq!invoicing_list; +print qq! CHECKED! + if ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list; +print qq!>Postal mail invoice!; +$invoicing_list = join(', ', grep { $_ ne 'POST' } @invoicing_list ); +print qq!Email invoice !; + +print "Billing type", + "", + &table("#c0c0c0"), ""; + +($payinfo, $payname)=( $cust_main->payinfo, $cust_main->payname, - $cust_main->otaker, ); -my($paydate); -if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { - $paydate="$2/$1" -} elsif ( $cust_main->paydate =~ /^(\d{2})-\d{2}-(\d{4}$)/ ) { - $paydate="$1/$2" -} -else { - $paydate=''; +%payby = ( + 'CARD' => qq!Credit card
                    ${r}
                    ${r}Exp !. expselect("CARD"). qq!
                    ${r}Name on card
                    !, + 'BILL' => qq!Billing
                    P.O.
                    ${r}Exp !. expselect("BILL", "12-2037"). qq!
                    ${r}Attention
                    !, + 'COMP' => qq!Complimentary
                    ${r}Approved by
                    ${r}Exp !. expselect("COMP"), +); +%paybychecked = ( + 'CARD' => qq!Credit card
                    ${r}
                    ${r}Exp !. expselect("CARD", $cust_main->paydate). qq!
                    ${r}Name on card
                    !, + 'BILL' => qq!Billing
                    P.O.
                    ${r}Exp !. expselect("BILL", $cust_main->paydate). qq!
                    ${r}Attention
                    !, + 'COMP' => qq!Complimentary
                    ${r}Approved by
                    ${r}Exp !. expselect("COMP", $cust_main->paydate), +); +for (qw(CARD BILL COMP)) { + print qq!payby eq "$_") { + print qq! CHECKED> $paybychecked{$_}!; + } else { + print qq!> $payby{$_}!; + } } -print < -END - -print qq!Exp. date (MM/YY or MM/YYYY) Billing name \ntax eq "Y"; -print qq!> Tax Exempt!; - -print <$otaker -
                    +print "$r required fields for each billing type"; + +unless ( $custnum ) { + # pry the wrong place for this logic. also pretty expensive + #use FS::part_pkg; + + #false laziness, copied from FS::cust_pkg::order + my $pkgpart; + if ( scalar(@agents) == 1 ) { + # $pkgpart->{PKGPART} is true iff $custnum may purchase $pkgpart + my($agent)=qsearchs('agent',{'agentnum'=> $agentnum }); + $pkgpart = $agent->pkgpart_hashref; + } else { + #can't know (agent not chosen), so, allow all + my %typenum; + foreach my $agent ( @agents ) { + next if $typenum{$agent->typenum}++; + #fixed in 5.004_05 #$pkgpart->{$_}++ foreach keys %{ $agent->pkgpart_hashref } + foreach ( keys %{ $agent->pkgpart_hashref } ) { $pkgpart->{$_}++; } #5.004_04 workaround + } + } + #eslaf + + my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } } + qsearch( 'part_pkg', {} ); + + if ( @part_pkg ) { + + print "

                    First package", &itable("#c0c0c0"), + qq!"; + + #false laziness: (mostly) copied from edit/svc_acct.cgi + #$ulen = $svc_acct->dbdef_table->column('username')->length; + $ulen = dbdef->table('svc_acct')->column('username')->length; + $ulen2 = $ulen+2; + print <Username + +Password + +(blank to generate) END + print qq!POP"; + } +} -print qq!
                    !; - -print < - - -END +$otaker = $cust_main->otaker; +print qq!!, + qq!

                    !, + "", +; diff --git a/htdocs/edit/cust_main_county-expand.cgi b/htdocs/edit/cust_main_county-expand.cgi index 59ff7043a..783e92826 100755 --- a/htdocs/edit/cust_main_county-expand.cgi +++ b/htdocs/edit/cust_main_county-expand.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county-expand.cgi: Expand a state into counties (output form) +# $Id: cust_main_county-expand.cgi,v 1.6 1999-01-25 12:09:54 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -8,39 +8,78 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county-expand.cgi,v $ +# Revision 1.6 1999-01-25 12:09:54 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:35 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:25 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:17:01 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/18 09:01:38 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $taxnum $cust_main_county $p1 $delim $expansion ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -$cgi->var('QUERY_STRING') =~ /^(\d+)$/ - or die "Illegal taxnum!"; -my($taxnum)=$1; +if ( $cgi->param('error') ) { + $taxnum = $cgi->param('taxnum'); + $delim = $cgi->param('delim'); + $expansion = $cgi->param('expansion'); +} else { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/ + or die "Illegal taxnum!"; + $taxnum = $1; + $delim = 'n'; + $expansion = ''; +} -my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}); +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}); die "Can't expand entry!" if $cust_main_county->getfield('county'); -print header("Tax Rate (expand state)", menubar( - 'Main Menu' => '../', -)), < +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Tax Rate (expand)", menubar( + 'Main Menu' => popurl(2), +)); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); + +print < - Separate counties by - line - (rumor has it broken on some browsers) or - whitespace. + Separate by +END +print 'line (rumor has it broken on some browsers) or', + 'whitespace.'; +print < -
                    +
                    diff --git a/htdocs/edit/cust_main_county.cgi b/htdocs/edit/cust_main_county.cgi index 904d58346..747a63df6 100755 --- a/htdocs/edit/cust_main_county.cgi +++ b/htdocs/edit/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# cust_main_county.cgi: Edit tax rates (output form) +# $Id: cust_main_county.cgi,v 1.8 1999-04-09 04:22:34 ivan Exp $ # # ivan@sisd.com 97-dec-13-16 # @@ -9,41 +9,75 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.8 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.7 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.6 1999/01/25 12:09:55 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:36 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:26 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 06:17:02 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/18 09:01:39 ivan +# i18n! i18n! +# use strict; -use CGI::Base; +use vars qw( $cgi $cust_main_county ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl table); +use FS::cust_main_county; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +print $cgi->header( '-expires' => 'now' ), header("Edit tax rates", menubar( + 'Main Menu' => popurl(2), +)); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -print header("Edit tax rates", menubar( - 'Main Menu' => '../', -)),< - +print qq!!, &table(), < + END -my($cust_main_county); foreach $cust_main_county ( qsearch('cust_main_county',{}) ) { my($hashref)=$cust_main_county->hashref; print < - + END + print ""; + print "
                    Country State County Tax
                    $hashref->{state}$hashref->{country}", $hashref->{state} + ? $hashref->{state} + : '(ALL)' + , "", $hashref->{county} ? $hashref->{county} : '(ALL)' diff --git a/htdocs/edit/cust_pay.cgi b/htdocs/edit/cust_pay.cgi index a6cb204d1..5dee76ed9 100755 --- a/htdocs/edit/cust_pay.cgi +++ b/htdocs/edit/cust_pay.cgi @@ -1,61 +1,82 @@ #!/usr/bin/perl -Tw # -# cust_pay.cgi: Add a payment (output form) +# $Id: cust_pay.cgi,v 1.6 1999-02-28 00:03:35 ivan Exp $ # # Usage: cust_pay.cgi invnum # http://server.name/path/cust_pay.cgi?invnum # -# Note: Should be run setuid as user nobody. -# # some hooks for modifications as well as additions, but needs work. # # ivan@voicenet.com 96-dec-11 # # rewrite ivan@sisd.com 98-mar-16 +# +# $Log: cust_pay.cgi,v $ +# Revision 1.6 1999-02-28 00:03:35 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/25 12:09:56 ivan +# yet more mod_perl stuff +# +# Revision 1.4 1999/01/19 05:13:37 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 09:41:27 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:03 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; +use vars qw( $cgi $invnum $p1 $_date $payby $payinfo $paid ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint invnum -$QUERY_STRING =~ /^(\d+)$/; -my($invnum)=$1; +if ( $cgi->param('error') ) { + $invnum = $cgi->param('invnum'); + $paid = $cgi->param('paid'); + $payby = $cgi->param('payby'); + $payinfo = $cgi->param('payinfo'); +} else { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $invnum = $1; + $paid = ''; + $payby = "BILL"; + $payinfo = ""; +} +$_date = time; + +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Enter payment", ''); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -SendHeaders(); # one guess. print < - - Enter payment - - -
                    -

                    Enter payment

                    -
                    - +
                     END
                     
                    -#invnum
                     print qq!Invoice #$invnum!;
                     
                    -#date
                    -my($date)=time;
                    -print qq!
                    Date: !, time2str("%D",$date), qq!!; +print qq!
                    Date: !, time2str("%D",$_date), qq!!; -#paid -print qq!
                    Amount \$!; +print qq!
                    Amount \$!; -#payby -my($payby)="BILL"; print qq!
                    Payby: $payby!; #payinfo (check # now as payby="BILL" hardcoded.. what to do later?) -my($payinfo)=""; print qq!
                    Check #!; #paybatch @@ -64,7 +85,7 @@ print qq!!; print <
                    -
                    + END print < +# +# Revision 1.7 1999/04/14 01:03:01 ivan +# oops, in 1.2 tree, can't do searches until [cgi|admin]suidsetup, +# bug is hidden by mod_perl persistance +# +# Revision 1.6 1999/02/28 00:03:36 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:18 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:38 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 09:41:28 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:04 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi %pkg %comment $custnum $p1 @cust_pkg + $cust_main $agent $type_pkgs $count %remove_pkg $pkgparts ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup getotaker); +use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(header popurl); +use FS::part_pkg; +use FS::type_pkgs; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -my(%pkg,%comment); +%pkg = (); +%comment = (); foreach (qsearch('part_pkg', {})) { $pkg{ $_ -> getfield('pkgpart') } = $_->getfield('pkg'); $comment{ $_ -> getfield('pkgpart') } = $_->getfield('comment'); } -#untaint custnum -$QUERY_STRING =~ /^(\d+)$/; -my($custnum)=$1; +if ( $cgi->param('error') ) { + $custnum = $cgi->param('custnum'); + %remove_pkg = map { $_ => 1 } $cgi->param('remove_pkg'); +} else { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $custnum = $1; + undef %remove_pkg; +} -my($otaker)=&getotaker; +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Add/Edit Packages", ''); -SendHeaders(); -print < - - Add/Edit Packages - - -
                    -

                    Add/Edit Packages

                    -
                    - -
                    -END +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -#custnum -print qq!!; +print qq!!; -#current packages (except cancelled packages) -my(@cust_pkg) = grep ! $_->getfield('cancel'), - qsearch('cust_pkg',{'custnum'=>$custnum}); +print qq!!; + +#current packages +@cust_pkg = qsearch('cust_pkg',{ 'custnum' => $custnum, 'cancel' => '' } ); if (@cust_pkg) { print <Current packages -These are packages the customer currently has. Select those packages you -wish to remove (if any).

                    +Current packages - select to remove (services are moved to a new package below) +

                    END my ($count) = 0 ; - print qq!
                    ! ; + print qq!
                    ! ; foreach (@cust_pkg) { - print qq!! if ($count ==0) ; + print '' if $count == 0; my($pkgnum,$pkgpart)=( $_->getfield('pkgnum'), $_->getfield('pkgpart') ); - print qq!\n!, - #now you've got to admit this bug was pretty cool - qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}\n!; + print qq!\n!; $count ++ ; if ($count == 2) { @@ -90,47 +115,52 @@ END print qq!\n! ; } } - print qq!
                    !, - #qq!$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}$pkgnum: $pkg{$pkgpart} - $comment{$pkgpart}
                    ! ; - - print "
                    "; + print qq!


                    !; } print <New packages -These are packages the customer can purchase. Specify the quantity to add -of each package.

                    +Order new packages

                    END -my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); -my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); +$agent = qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); -my($type_pkgs); -my ($count) = 0 ; -print qq!
                    ! ; +$count = 0; +$pkgparts = 0; +print qq!
                    !; foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + $pkgparts++; my($pkgpart)=$type_pkgs->pkgpart; - print qq!! if ($count == 0) ; + print qq!! if ( $count == 0 ); + my $value = $cgi->param("pkg$pkgpart") || 0; print < - + $pkgpart: $pkg{$pkgpart} - $comment{$pkgpart}\n END $count ++ ; - if ($count == 2) - { + if ( $count == 2 ) { print qq!\n! ; - $count = 0 ; + $count = 0; } } -print qq!
                    ! ; +print qq!!; -#otaker -print qq!\n!; +unless ( $pkgparts ) { + my $p2 = popurl(2); + my $typenum = $agent->typenum; + my $agent_type = qsearchs( 'agent_type', { 'typenum' => $typenum } ); + my $atype = $agent_type->atype; + print <package definitions, or agent type +$atype not allowed to purchase +any packages.) +END +} #submit -print qq!

                    \n!; - print < diff --git a/htdocs/edit/part_pkg.cgi b/htdocs/edit/part_pkg.cgi index 9fe739bb7..f7ade88c8 100755 --- a/htdocs/edit/part_pkg.cgi +++ b/htdocs/edit/part_pkg.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: part_pkg.cgi,v 1.9 1999-02-07 09:59:19 ivan Exp $ +# # part_pkg.cgi: Add/Edit package (output form) # # ivan@sisd.com 97-dec-10 @@ -9,37 +11,99 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: part_pkg.cgi,v $ +# Revision 1.9 1999-02-07 09:59:19 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.8 1999/01/19 05:13:39 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.7 1999/01/18 09:41:29 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.6 1998/12/17 06:17:05 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.5 1998/11/21 07:12:26 ivan +# *** empty log message *** +# +# Revision 1.4 1998/11/21 07:11:08 ivan +# *** empty log message *** +# +# Revision 1.3 1998/11/21 07:07:40 ivan +# popurl, bugfix +# +# Revision 1.2 1998/11/15 13:14:55 ivan +# first pass as per-user custom pricing +# use strict; -use CGI::Base; +use vars qw( $cgi $part_pkg $action $query $hashref $part_svc $count ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::part_pkg; +use FS::part_svc; use FS::pkg_svc; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. +if ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) { + $cgi->param('clone', $1); +} else { + $cgi->param('clone', ''); +} +if ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + $cgi->param('pkgnum', $1); +} else { + $cgi->param('pkgnum', ''); +} -my($part_pkg,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $part_pkg=qsearchs('part_pkg',{'pkgpart'=>$1}); - $action='Edit'; -} else { #adding - $part_pkg=create FS::part_pkg {}; - $action='Add'; +($query) = $cgi->keywords; +$action = ''; +$part_pkg = ''; +if ( $cgi->param('error') ) { + $part_pkg = new FS::part_pkg ( { + map { $_, scalar($cgi->param($_)) } fields('part_pkg') + } ); } -my($hashref)=$part_pkg->hashref; +if ( $cgi->param('clone') ) { + $action='Custom Pricing'; + my $old_part_pkg = + qsearchs('part_pkg', { 'pkgpart' => $cgi->param('clone') } ); + $part_pkg ||= $old_part_pkg->clone; +} elsif ( $query && $query =~ /^(\d+)$/ ) { + $part_pkg ||= qsearchs('part_pkg',{'pkgpart'=>$1}); +} else { + $part_pkg ||= new FS::part_pkg {}; +} +$action ||= $part_pkg->pkgpart ? 'Edit' : 'Add'; +$hashref = $part_pkg->hashref; + +print $cgi->header( '-expires' => 'now' ), header("$action Package Definition", menubar( + 'Main Menu' => popurl(2), + 'View all packages' => popurl(2). 'browse/part_pkg.cgi', +)); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -print header("$action Package Definition", menubar( - 'Main Menu' => '../', - 'View all packages' => '../browse/part_pkg.cgi', -)), '
                    '; +print ''; + +if ( $cgi->param('clone') ) { + print qq!!; +} +if ( $cgi->param('pkgnum') ) { + print qq!!; +} print qq!!, "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)"; @@ -54,41 +118,51 @@ Frequency (months) of recurring fee !, - qq!!, $part_svc->getfield('svc'), ""; - $count ++ ; - if ($count == 2) - { - print qq!! ; - $count = 0 ; + #? #next unless $pkg_svc; + + unless ( defined ($cgi->param('clone')) && $cgi->param('clone') ) { + print '' if $count == 0 ; + print qq!quantity || 0, + qq!">!, $part_svc->getfield('svc'), ""; + $count++; + if ($count == 2) + { + print ''; + $count = 0; + } + } else { + print qq!quantity || 0, qq!">\n!; } } -print qq!! if ($count != 0) ; -print ""; +unless ( $cgi->param('clone') ) { + print qq!! if ($count != 0) ; + print ""; +} print qq!
                    header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.2 1998/12/17 06:17:06 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base; +use vars qw( $cgi $part_referral $action $hashref $p1 $query ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); use FS::part_referral; -use FS::CGI qw(header menubar); +use FS::CGI qw(header menubar popurl); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($part_referral,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing - $part_referral=qsearchs('part_referral',{'refnum'=>$1}); - $action='Edit'; +if ( $cgi->param('error') ) { + $part_referral = new FS::part_referral ( { + map { $_, scalar($cgi->param($_)) } fields('part_referral') + } ); +} elsif ( $cgi->keywords ) { + my($query) = $cgi->keywords; + $query =~ /^(\d+)$/; + $part_referral = qsearchs( 'part_referral', { 'refnum' => $1 } ); } else { #adding - $part_referral=create FS::part_referral {}; - $action='Add'; + $part_referral = new FS::part_referral {}; } -my($hashref)=$part_referral->hashref; +$action = $part_referral->refnum ? 'Edit' : 'Add'; +$hashref = $part_referral->hashref; -print header("$action Referral", menubar( - 'Main Menu' => '../', - 'View all referrals' => "../browse/part_referral.cgi", -)), < -END +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action Referral", menubar( + 'Main Menu' => popurl(2), + 'View all referrals' => popurl(2). "browse/part_referral.cgi", +)); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -#display +print qq!!; print qq!!, "Referral #", $hashref->{refnum} ? $hashref->{refnum} : "(NEW)"; diff --git a/htdocs/edit/part_svc.cgi b/htdocs/edit/part_svc.cgi index 491c013fe..4c70f0762 100755 --- a/htdocs/edit/part_svc.cgi +++ b/htdocs/edit/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# part_svc.cgi: Add/Edit service (output form) +# $Id: part_svc.cgi,v 1.13 2000-06-15 11:10:31 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -8,38 +8,83 @@ # bmccane@maxbaud.net 98-apr-3 # # use FS::CGI, added inline documentation ivan@sisd.com 98-jul-12 +# +# $Log: part_svc.cgi,v $ +# Revision 1.13 2000-06-15 11:10:31 ivan +# update to the inline documentation, hopefully will make things more clear +# +# Revision 1.12 1999/04/09 04:22:34 ivan +# also table() +# +# Revision 1.11 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.10 1999/04/08 13:01:50 ivan +# [ AND DOCUMENT! ] all svc_acct services should have a default +# or fixed shell +# +# Revision 1.9 1999/02/23 08:09:21 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.8 1999/02/07 09:59:21 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:42 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:31 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:21 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 06:17:07 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.3 1998/11/21 06:43:26 ivan +# visual +# use strict; -use CGI::Base; +use vars qw( $cgi $part_svc $action $query $hashref $p %defs $svcdb ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_svc qw(fields); -use FS::CGI qw(header menubar); +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(header menubar popurl table); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($part_svc,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $part_svc = new FS::part_svc ( { + map { $_, scalar($cgi->param($_)) } fields('part_svc') + } ); +} elsif ( $cgi->keywords ) { + my ($query) = $cgi->keywords; + $query =~ /^(\d+)$/; $part_svc=qsearchs('part_svc',{'svcpart'=>$1}); - $action='Edit'; } else { #adding - $part_svc=create FS::part_svc {}; - $action='Add'; + $part_svc = new FS::part_svc {}; } -my($hashref)=$part_svc->hashref; +$action = $part_svc->svcpart ? 'Edit' : 'Add'; +$hashref = $part_svc->hashref; -print header("$action Service Definition", menubar( - 'Main Menu' => '../', - 'View all services' => '../browse/part_svc.cgi', -)), ''; +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header("$action Service Definition", menubar( + 'Main Menu' => $p, + 'View all services' => "${p}browse/part_svc.cgi", +)); +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); +print ''; print qq!!, "Service Part #", $hashref->{svcpart} ? $hashref->{svcpart} : "(NEW)"; @@ -47,45 +92,48 @@ print qq!!, print < Service -Table ', + map '{svcdb}). ">$_\n", qw( + svc_acct svc_domain svc_acct_sm + ); + print ""; +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo + +print <Field Modifier END #these might belong somewhere else for other user interfaces #pry need to eventually create stuff that's shared amount UIs -my(%defs)=( +%defs = ( 'svc_acct' => { 'dir' => 'Home directory', 'uid' => 'UID (set to fixed and blank for dial-only)', - 'slipip' => 'IP address', - 'popnum' => 'POP number', + 'slipip' => 'IP address (set to fixed and blank to disable dialin)', + 'popnum' => qq!POP number!, 'username' => 'Username', 'quota' => '(unimplemented)', '_password' => 'Password', 'gid' => 'GID (when blank, defaults to UID)', - 'shell' => 'Shell', + 'shell' => 'Shell (all service definitions should have a default or fixed shell that is present in the shells configuration file)', 'finger' => 'GECOS', }, 'svc_domain' => { @@ -105,9 +153,9 @@ my(%defs)=( }, ); -my($svcdb); +# svc_acct svc_domain svc_acct_sm svc_charge svc_wo foreach $svcdb ( qw( - svc_acct svc_domain svc_acct_sm svc_charge svc_wo + svc_acct svc_domain svc_acct_sm ) ) { my(@rows)=map { /^${svcdb}__(.*)$/; $1 } @@ -119,25 +167,28 @@ foreach $svcdb ( qw( my($ptmp)="$svcdb"; my($row); foreach $row (@rows) { - my($value)=$part_svc->getfield($svcdb.'__'.$row); - my($flag)=$part_svc->getfield($svcdb.'__'.$row.'_flag'); - print "$ptmp$row - $defs{$svcdb}{$row}"; + my $value = $part_svc->getfield($svcdb. '__'. $row); + my $flag = $part_svc->getfield($svcdb. '__'. $row. '_flag'); + print "$ptmp$row"; + print "- $defs{$svcdb}{$row}" + if defined $defs{$svcdb}{$row}; + print ""; print qq!
                    Off"; + ' CHECKED'x($flag eq ''). ">Off"; print qq!Default "; print qq!Fixed "; - print qq!
                    !, - ""; + print qq!!, + "\n"; $ptmp=''; } } print ""; -print qq!\n

                    !; + qq!">!; print <cgi); +$cgi = new CGI; -my($agentnum)=$req->param('agentnum'); +&cgisuidsetup($cgi); -my($old)=qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; +$agentnum = $cgi->param('agentnum'); -#unmunge typenum -$req->param('typenum') =~ /^(\d+)(:.*)?$/; -$req->param('typenum',$1); +$old = qsearchs('agent',{'agentnum'=>$agentnum}) if $agentnum; -my($new)=create FS::agent ( { +$new = new FS::agent ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('agent') } ); -my($error); if ( $agentnum ) { $error=$new->replace($old); } else { @@ -44,10 +61,9 @@ if ( $agentnum ) { } if ( $error ) { - &idiot($error); + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string ); } else { - #$req->cgi->redirect("../../view/agent.cgi?$agentnum"); - #$req->cgi->redirect("../../edit/agent.cgi?$agentnum"); - $req->cgi->redirect("../../browse/agent.cgi"); + print $cgi->redirect(popurl(3). "browse/agent.cgi"); } diff --git a/htdocs/edit/process/agent_type.cgi b/htdocs/edit/process/agent_type.cgi index 43f129fd5..99c54ab3b 100755 --- a/htdocs/edit/process/agent_type.cgi +++ b/htdocs/edit/process/agent_type.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent_type.cgi: Edit agent type (process form) +# $Id: agent_type.cgi,v 1.7 1999-01-25 12:09:58 ivan Exp $ # # ivan@sisd.com 97-dec-11 # @@ -8,29 +8,51 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: agent_type.cgi,v $ +# Revision 1.7 1999-01-25 12:09:58 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:13:48 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:50 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:27 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:17 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/21 07:49:20 ivan +# s/CGI::Request/CGI.pm/ +# use strict; -use CGI::Request; +use vars qw ( $cgi $typenum $old $new $error $part_pkg ); +use CGI; use CGI::Carp qw(fatalsToBrowser); +use FS::CGI qw( popurl); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::agent_type qw(fields); +use FS::Record qw(qsearch qsearchs fields); +use FS::agent_type; use FS::type_pkgs; -use FS::CGI qw(idiot); +use FS::part_pkg; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($typenum)=$req->param('typenum'); -my($old)=qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; +$typenum = $cgi->param('typenum'); +$old = qsearchs('agent_type',{'typenum'=>$typenum}) if $typenum; -my($new)=create FS::agent_type ( { +$new = new FS::agent_type ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('agent_type') } ); -my($error); if ( $typenum ) { $error=$new->replace($old); } else { @@ -39,11 +61,11 @@ if ( $typenum ) { } if ( $error ) { - idiot($error); + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "agent_type.cgi?". $cgi->query_string ); exit; } -my($part_pkg); foreach $part_pkg (qsearch('part_pkg',{})) { my($pkgpart)=$part_pkg->getfield('pkgpart'); @@ -51,33 +73,24 @@ foreach $part_pkg (qsearch('part_pkg',{})) { 'typenum' => $typenum, 'pkgpart' => $pkgpart, }); - if ( $type_pkgs && ! $req->param("pkgpart$pkgpart") ) { + if ( $type_pkgs && ! $cgi->param("pkgpart$pkgpart") ) { my($d_type_pkgs)=$type_pkgs; #need to save $type_pkgs for below. - $error=$d_type_pkgs->del; #FS::Record not FS::type_pkgs, - #so ->del not ->delete. hmm. hmm. - if ( $error ) { - idiot($error); - exit; - } + $error=$d_type_pkgs->delete; + die $error if $error; - } elsif ( $req->param("pkgpart$pkgpart") + } elsif ( $cgi->param("pkgpart$pkgpart") && ! $type_pkgs ) { #ok to clobber it now (but bad form nonetheless?) - $type_pkgs=create FS::type_pkgs ({ + $type_pkgs=new FS::type_pkgs ({ 'typenum' => $typenum, 'pkgpart' => $pkgpart, }); $error= $type_pkgs->insert; - if ( $error ) { - idiot($error); - exit; - } + die $error if $error; } } -#$req->cgi->redirect("../../view/agent_type.cgi?$typenum"); -#$req->cgi->redirect("../../edit/agent_type.cgi?$typenum"); -$req->cgi->redirect("../../browse/agent_type.cgi"); +print $cgi->redirect(popurl(3). "browse/agent_type.cgi"); diff --git a/htdocs/edit/process/cust_credit.cgi b/htdocs/edit/process/cust_credit.cgi index e660b4c78..ea9c5a3a2 100755 --- a/htdocs/edit/process/cust_credit.cgi +++ b/htdocs/edit/process/cust_credit.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_credit.cgi: Add a credit (process form) +# $Id: cust_credit.cgi,v 1.7 1999-04-07 15:23:05 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_credit.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-05 -> 96-dec-08 # # post a refund if $new_paybatch @@ -20,51 +18,59 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_credit.cgi,v $ +# Revision 1.7 1999-04-07 15:23:05 ivan +# don't use anchor in redirect +# +# Revision 1.6 1999/02/28 00:03:41 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/25 12:09:59 ivan +# yet more mod_perl stuff +# +# Revision 1.4 1999/01/19 05:13:49 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:47:51 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:18 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $custnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw(popurl); +use FS::Record qw(fields); use FS::cust_credit; -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; -my($custnum)=$1; +$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!"; +$custnum = $1; -$req->param('otaker',getotaker); +$cgi->param('otaker',getotaker); -my($new) = create FS::cust_credit ( { +$new = new FS::cust_credit ( { map { - $_, $req->param($_); - } qw(custnum _date amount otaker reason) + $_, scalar($cgi->param($_)); + #} qw(custnum _date amount otaker reason) + } fields('cust_credit') } ); -my($error); $error=$new->insert; -&idiot($error) if $error; - -#no errors, no refund, so view our credit. -$req->cgi->redirect("../../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print < - - Error posting credit/refund - - -
                    -

                    Error posting credit/refund

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and press the Post button again. - - -END +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_credit.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); } + diff --git a/htdocs/edit/process/cust_main.cgi b/htdocs/edit/process/cust_main.cgi index 7664dfcb8..25dc0299b 100755 --- a/htdocs/edit/process/cust_main.cgi +++ b/htdocs/edit/process/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_main.cgi: Edit a customer (process form) +# $Id: cust_main.cgi,v 1.11 1999-08-10 12:54:06 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_main.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-04 # # added referral check @@ -20,83 +18,175 @@ # Changes to allow page to work at a relative position in server # Changed 'day' to 'daytime' because Pg6.3 reserves the day word # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_main.cgi,v $ +# Revision 1.11 1999-08-10 12:54:06 ivan +# use FS::cust_pkg::pkgpart_href +# +# Revision 1.10 1999/04/14 07:47:53 ivan +# i18n fixes +# +# Revision 1.9 1999/04/07 15:22:19 ivan +# don't use anchor in redirect +# +# Revision 1.8 1999/03/25 13:55:10 ivan +# one-screen new customer entry (including package and service) for simple +# packages with one svc_acct service +# +# Revision 1.7 1999/02/28 00:03:42 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:10:00 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:50 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:22:32 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.3 1998/12/17 08:40:19 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 08:57:36 ivan +# i18n, s/CGI-modules/CGI.pm/, FS::CGI::idiot instead of inline, FS::CGI::popurl +# use strict; -use CGI::Request; +use vars qw( $cgi $payby @invoicing_list $new $custnum $error ); +use vars qw( $cust_pkg $cust_svc $svc_acct ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::UID qw(cgisuidsetup getotaker); +use FS::CGI qw( popurl ); +use FS::Record qw( qsearch qsearchs fields ); use FS::cust_main; +use FS::type_pkgs; +use FS::agent; -my($req)=new CGI::Request; # create form object +$cgi = new CGI; +&cgisuidsetup($cgi); -&cgisuidsetup($req->cgi); +#unmunge stuff -#create new record object +$cgi->param('tax','') unless defined($cgi->param('tax')); + +$cgi->param('refnum', (split(/:/, ($cgi->param('refnum'))[0] ))[0] ); + +$cgi->param('state') =~ /^(\w*)( \(([\w ]+)\))? ?\/ ?(\w+)$/ + or die "Oops, illegal \"state\" param: ". $cgi->param('state'); +$cgi->param('state', $1); +$cgi->param('county', $3 || ''); +$cgi->param('country', $4); -#unmunge agentnum -$req->param('agentnum', - (split(/:/, ($req->param('agentnum'))[0] ))[0] -); +if ( $payby = $cgi->param('payby') ) { + $cgi->param('payinfo', $cgi->param( $payby. '_payinfo' ) ); + $cgi->param('paydate', + $cgi->param( $payby. '_month' ). '-'. $cgi->param( $payby. '_year' ) ); + $cgi->param('payname', $cgi->param( $payby. '_payname' ) ); +} -#unmunge tax -$req->param('tax','') unless defined($req->param('tax')); +$cgi->param('otaker', &getotaker ); -#unmunge refnum -$req->param('refnum', - (split(/:/, ($req->param('refnum'))[0] ))[0] -); +@invoicing_list = split( /\s*\,\s*/, $cgi->param('invoicing_list') ); +push @invoicing_list, 'POST' if $cgi->param('invoicing_list_POST'); -#unmunge state/county -$req->param('state') =~ /^(\w+)( \((\w+)\))?$/; -$req->param('state', $1); -$req->param('county', $3 || ''); +#create new record object -my($new) = create FS::cust_main ( { +$new = new FS::cust_main ( { map { - $_, $req->param("$_") || '' - } qw(custnum agentnum last first ss company address1 address2 city county - state zip country daytime night fax payby payinfo paydate payname tax - otaker refnum) + $_, scalar($cgi->param($_)) +# } qw(custnum agentnum last first ss company address1 address2 city county +# state zip daytime night fax payby payinfo paydate payname tax +# otaker refnum) + } fields('cust_main') } ); -if ( $new->custnum eq '' ) { +#perhaps the invocing_list magic should move to cust_main.pm? +$error = $new->check_invoicing_list( \@invoicing_list ); - my($error)=$new->insert; - &idiot($error) if $error; +#perhaps this stuff should go to cust_main.pm as well +$cust_pkg = ''; +$svc_acct = ''; +if ( $new->custnum eq '' ) { + if ( $cgi->param('pkgpart_svcpart') ) { + my $x = $cgi->param('pkgpart_svcpart'); + $x =~ /^(\d+)_(\d+)$/; + my($pkgpart, $svcpart) = ($1, $2); + #false laziness: copied from FS::cust_pkg::order (which should become a + #FS::cust_main method) + my(%part_pkg); + # generate %part_pkg + # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart + my $agent = qsearchs('agent',{'agentnum'=> $new->agentnum }); + #my($type_pkgs); + #foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) { + # my($pkgpart)=$type_pkgs->pkgpart; + # $part_pkg{$pkgpart}++; + #} + # $pkgpart_href->{PKGPART} is true iff $custnum may purchase $pkgpart + my $pkgpart_href = $agent->pkgpart_hashref; + #eslaf + + # this should wind up in FS::cust_pkg! + $error ||= "Agent ". $new->agentnum. " (type ". $agent->typenum. ") can't". + "purchase pkgpart ". $pkgpart + #unless $part_pkg{ $pkgpart }; + unless $pkgpart_href->{ $pkgpart }; + + $cust_pkg = new FS::cust_pkg ( { + #later 'custnum' => $custnum, + 'pkgpart' => $pkgpart, + } ); + $error ||= $cust_pkg->check; + + #$cust_svc = new FS::cust_svc ( { 'svcpart' => $svcpart } ); + + #$error ||= $cust_svc->check; + + $svc_acct = new FS::svc_acct ( { + 'svcpart' => $svcpart, + 'username' => $cgi->param('username'), + '_password' => $cgi->param('_password'), + 'popnum' => $cgi->param('popnum'), + } ); + + my $y = $svc_acct->setdefault; # arguably should be in new method + $error ||= $y unless ref($y); + #and just in case you were silly + $svc_acct->svcpart($svcpart); + $svc_acct->username($cgi->param('username')); + $svc_acct->_password($cgi->param('_password')); + $svc_acct->popnum($cgi->param('popnum')); + + $error ||= $svc_acct->check; + + } elsif ( $cgi->param('username') ) { #good thing to catch + $error = "Can't assign username without a package!"; + } + + $error ||= $new->insert; + if ( $cust_pkg && ! $error ) { + $cust_pkg->custnum( $new->custnum ); + $error ||= $cust_pkg->insert; + warn "WARNING: $error on pre-checked cust_pkg record!" if $error; + $svc_acct->pkgnum( $cust_pkg->pkgnum ); + $error ||= $svc_acct->insert; + warn "WARNING: $error on pre-checked svc_acct record!" if $error; + } } else { #create old record object - - my($old) = qsearchs( 'cust_main', { 'custnum', $new->custnum } ); - &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 < - - Error updating customer information - - -

                    -

                    Error updating customer information

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and submit the form again. - - -END - - exit; - + my $old = qsearchs( 'cust_main', { 'custnum' => $new->custnum } ); + $error ||= "Old record not found!" unless $old; + $error ||= $new->replace($old); } +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main.cgi?". $cgi->query_string ); +} else { + $new->invoicing_list( \@invoicing_list ); + $custnum = $new->custnum; + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); +} diff --git a/htdocs/edit/process/cust_main_county-expand.cgi b/htdocs/edit/process/cust_main_county-expand.cgi index a821560c6..a174a0a8e 100755 --- a/htdocs/edit/process/cust_main_county-expand.cgi +++ b/htdocs/edit/process/cust_main_county-expand.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/cust_main_county-expand.cgi: Expand counties (process form) +# $Id: cust_main_county-expand.cgi,v 1.7 2000-12-21 05:22:30 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -12,45 +12,73 @@ # lose background, FS::CGI # undo default tax to 0.0 if using Pg6.3: comes from pre-expanded record # for that state -#ivan@sisd.com 98-sep-2 +# ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county-expand.cgi,v $ +# Revision 1.7 2000-12-21 05:22:30 ivan +# perldoc -f split +# +# Revision 1.6 1999/01/25 12:19:07 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:51 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:52 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/17 08:40:20 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 09:01:40 ivan +# i18n! i18n! +# use strict; -use CGI::Request; +use vars qw ( $cgi $taxnum $cust_main_county @expansion $expansion ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup datasrc); use FS::Record qw(qsearch qsearchs); +use FS::CGI qw(popurl); use FS::cust_main_county; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::cust_main; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; -my($taxnum)=$1; -my($cust_main_county)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}) +$cgi->param('taxnum') =~ /^(\d+)$/ or die "Illegal taxnum!"; +$taxnum = $1; +$cust_main_county = qsearchs('cust_main_county',{'taxnum'=>$taxnum}) or die ("Unknown taxnum!"); -my(@counties); -if ( $req->param('delim') eq 'n' ) { - @counties=split(/\n/,$req->param('counties')); -} elsif ( $req->param('delim') eq 's' ) { - @counties=split(/\s+/,$req->param('counties')); +if ( $cgi->param('delim') eq 'n' ) { + @expansion=split(/\n/,$cgi->param('expansion')); +} elsif ( $cgi->param('delim') eq 's' ) { + @expansion=split(' ',$cgi->param('expansion')); } else { die "Illegal delim!"; } -@counties=map { - /^\s*([\w\- ]+)\s*$/ or eidiot("Illegal county"); +@expansion=map { + unless ( /^\s*([\w\- ]+)\s*$/ ) { + $cgi->param('error', "Illegal item in expansion"); + print $cgi->redirect(popurl(2). "cust_main_county-expand.cgi?". $cgi->query_string ); + exit; + } $1; -} @counties; +} @expansion; -my($county); -foreach ( @counties) { +foreach ( @expansion) { my(%hash)=$cust_main_county->hash; - my($new)=create FS::cust_main_county \%hash; + my($new)=new FS::cust_main_county \%hash; $new->setfield('taxnum',''); - $new->setfield('county',$_); + if ( ! $cust_main_county->state ) { + $new->setfield('state',$_); + } else { + $new->setfield('county',$_); + } #if (datasrc =~ m/Pg/) #{ # $new->setfield('tax',0.0); @@ -62,10 +90,11 @@ foreach ( @counties) { unless ( qsearch('cust_main',{ 'state' => $cust_main_county->getfield('state'), 'county' => $cust_main_county->getfield('county'), + 'country' => $cust_main_county->getfield('country'), } ) ) { my($error)=($cust_main_county->delete); die $error if $error; } -$req->cgi->redirect("../../edit/cust_main_county.cgi"); +print $cgi->redirect(popurl(3). "edit/cust_main_county.cgi"); diff --git a/htdocs/edit/process/cust_main_county.cgi b/htdocs/edit/process/cust_main_county.cgi index 58eaa63ce..0fc1708c5 100755 --- a/htdocs/edit/process/cust_main_county.cgi +++ b/htdocs/edit/process/cust_main_county.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/agent.cgi: Edit cust_main_county (process form) +# $Id: cust_main_county.cgi,v 1.6 1999-01-25 12:19:08 ivan Exp $ # # ivan@sisd.com 97-dec-16 # @@ -8,31 +8,53 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: cust_main_county.cgi,v $ +# Revision 1.6 1999-01-25 12:19:08 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:52 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:53 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/17 08:40:21 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/18 09:01:41 ivan +# i18n! i18n! +# use strict; -use CGI::Request; +use vars qw( $cgi ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::Record qw(qsearch qsearchs); use FS::cust_main_county; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -foreach ( $req->params ) { +foreach ( $cgi->param ) { /^tax(\d+)$/ or die "Illegal form $_!"; my($taxnum)=$1; my($old)=qsearchs('cust_main_county',{'taxnum'=>$taxnum}) or die "Couldn't find taxnum $taxnum!"; - next unless $old->getfield('tax') ne $req->param("tax$taxnum"); + next unless $old->getfield('tax') ne $cgi->param("tax$taxnum"); my(%hash)=$old->hash; - $hash{tax}=$req->param("tax$taxnum"); - my($new)=create FS::cust_main_county \%hash; + $hash{tax}=$cgi->param("tax$taxnum"); + my($new)=new FS::cust_main_county \%hash; my($error)=$new->replace($old); - eidiot($error) if $error; + if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_main_county.cgi?". $cgi->query_string ); + exit; + } } -$req->cgi->redirect("../../browse/cust_main_county.cgi"); +print $cgi->redirect(popurl(3). "browse/cust_main_county.cgi"); diff --git a/htdocs/edit/process/cust_pay.cgi b/htdocs/edit/process/cust_pay.cgi index 9ec97532b..ca5029c3c 100755 --- a/htdocs/edit/process/cust_pay.cgi +++ b/htdocs/edit/process/cust_pay.cgi @@ -1,57 +1,67 @@ #!/usr/bin/perl -Tw # -# process/cust_pay.cgi: Add a payment (process form) +# $Id: cust_pay.cgi,v 1.7 1999-02-28 00:03:43 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_pay.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-11 # # rewrite ivan@sisd.com 98-mar-16 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_pay.cgi,v $ +# Revision 1.7 1999-02-28 00:03:43 ivan +# removed misleading comments +# +# Revision 1.6 1999/01/25 12:19:09 ivan +# yet more mod_perl stuff +# +# Revision 1.5 1999/01/19 05:13:53 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:54 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:28 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:22 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $invnum $new $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::cust_pay qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(fields); +use FS::cust_pay; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($invnum)=$1; +$cgi->param('invnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$invnum = $1; -my($new) = create FS::cust_pay ( { +$new = new FS::cust_pay ( { map { - $_, $req->param($_); - } qw(invnum paid _date payby payinfo paybatch) + $_, scalar($cgi->param($_)); + #} qw(invnum paid _date payby payinfo paybatch) + } fields('cust_pay') } ); -my($error); $error=$new->insert; -if ($error) { #error! - CGI::Base::SendHeaders(); # one guess - print < - - Error posting payment - - -

                    -

                    Error posting payment

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and press the Post button again. - - -END -} else { #no errors! - $req->cgi->redirect("../../view/cust_bill.cgi?$invnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). 'cust_pay.cgi?'. $cgi->query_string ); + exit; +} else { + print $cgi->redirect(popurl(3). "view/cust_bill.cgi?$invnum"); } diff --git a/htdocs/edit/process/cust_pkg.cgi b/htdocs/edit/process/cust_pkg.cgi index 6f5bc875a..9d82b3c24 100755 --- a/htdocs/edit/process/cust_pkg.cgi +++ b/htdocs/edit/process/cust_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/cust_pkg.cgi: Add/edit packages (process form) +# $Id: cust_pkg.cgi,v 1.7 1999-04-07 15:24:06 ivan Exp $ # # this is for changing packages around, not for editing things within the # package @@ -8,8 +8,6 @@ # Usage: post form to: # http://server.name/path/cust_pkg.cgi # -# Note: Should be run setuid root as user nobody. -# # ivan@voicenet.com 97-mar-21 - 97-mar-24 # # rewrote for new API @@ -19,55 +17,64 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.7 1999-04-07 15:24:06 ivan +# don't use anchor in redirect +# +# Revision 1.6 1999/02/28 00:03:44 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:26 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.3 1999/01/19 05:13:54 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.2 1998/12/17 08:40:23 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $custnum @remove_pkgnums @pkgparts $pkgpart $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::cust_pkg; -my($req)=new CGI::Request; # create form object - -&cgisuidsetup($req->cgi); +$cgi = new CGI; # create form object +&cgisuidsetup($cgi); +$error = ''; #untaint custnum -$req->param('new_custnum') =~ /^(\d+)$/; -my($custnum)=$1; +$cgi->param('custnum') =~ /^(\d+)$/; +$custnum = $1; -my(@remove_pkgnums) = map { +@remove_pkgnums = map { /^(\d+)$/ or die "Illegal remove_pkg value!"; $1; -} $req->param('remove_pkg'); +} $cgi->param('remove_pkg'); -my(@pkgparts); -my($pkgpart); -foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $req->params ) { - my($num_pkgs)=$req->param("pkg$pkgpart"); - while ( $num_pkgs-- ) { - push @pkgparts,$pkgpart; +foreach $pkgpart ( map /^pkg(\d+)$/ ? $1 : (), $cgi->param ) { + if ( $cgi->param("pkg$pkgpart") =~ /^(\d+)$/ ) { + my $num_pkgs = $1; + while ( $num_pkgs-- ) { + push @pkgparts,$pkgpart; + } + } else { + $error = "Illegal quantity"; + last; } } -my($error) = FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); +$error ||= FS::cust_pkg::order($custnum,\@pkgparts,\@remove_pkgnums); if ($error) { - CGI::Base::SendHeaders(); - print < - - Error updating packages - - -

                    -

                    Error updating packages

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and submit the form again. - - -END + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "cust_pkg.cgi?". $cgi->query_string ); } else { - $req->cgi->redirect("../../view/cust_main.cgi?$custnum#cust_pkg"); + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum"); } diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index 7d787819a..5af9055d6 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,5 +1,7 @@ #!/usr/bin/perl -Tw # +# $Id: part_pkg.cgi,v 1.9 2001-04-09 23:05:16 ivan Exp $ +# # process/part_pkg.cgi: Edit package definitions (process form) # # ivan@sisd.com 97-dec-10 @@ -13,67 +15,134 @@ # Added `|| 0 ' when getting quantity off web page ivan@sisd.com 98-jun-4 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_pkg.cgi,v $ +# Revision 1.9 2001-04-09 23:05:16 ivan +# Transactions Part I!!! +# +# Revision 1.8 1999/02/07 09:59:27 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:55 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 22:47:56 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.5 1998/12/30 23:03:29 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 08:40:24 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.3 1998/11/21 07:17:58 ivan +# bugfix to work for regular aswell as custom pricing +# +# Revision 1.2 1998/11/15 13:16:15 ivan +# first pass as per-user custom pricing +# use strict; -use CGI::Request; +use vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::part_pkg qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::part_pkg; use FS::pkg_svc; -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::cust_pkg; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +$dbh = &cgisuidsetup($cgi); -my($pkgpart)=$req->param('pkgpart'); +$pkgpart = $cgi->param('pkgpart'); -my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; +$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; -my($new)=create FS::part_pkg ( { +$new = new FS::part_pkg ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('part_pkg') } ); +#most of the stuff below should move to part_pkg.pm + +foreach $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + unless ( $quantity =~ /^(\d+)$/ ) { + $cgi->param('error', "Illegal quantity" ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; + } +} + +local $SIG{HUP} = 'IGNORE'; +local $SIG{INT} = 'IGNORE'; +local $SIG{QUIT} = 'IGNORE'; +local $SIG{TERM} = 'IGNORE'; +local $SIG{TSTP} = 'IGNORE'; +local $SIG{PIPE} = 'IGNORE'; + +local $FS::UID::AutoCommit = 0; + if ( $pkgpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; - $pkgpart=$new->getfield('pkgpart'); + $error = $new->insert; + $pkgpart=$new->pkgpart; +} +if ( $error ) { + $dbh->rollback; + $cgi->param('error', $error ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; } -my($part_svc); foreach $part_svc (qsearch('part_svc',{})) { -# don't update non-changing records in part_svc (causing harmless but annoying -# "Records identical" errors). ivan@sisd.com 98-jan-19 - #my($quantity)=$req->param('pkg_svc'. $part_svc->getfield('svcpart')), - my($quantity)=$req->param('pkg_svc'. $part_svc->svcpart) || 0, - my($old_pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - }); - my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; next unless $old_quantity != $quantity; #!here - my($new_pkg_svc)=create FS::pkg_svc({ + my $new_pkg_svc = new FS::pkg_svc( { 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - #'quantity' => $req->param('pkg_svc'. $part_svc->getfield('svcpart')), + 'svcpart' => $part_svc->svcpart, 'quantity' => $quantity, - }); - if ($old_pkg_svc) { - my($error)=$new_pkg_svc->replace($old_pkg_svc); - eidiot($error) if $error; + } ); + if ( $old_pkg_svc ) { + my $myerror = $new_pkg_svc->replace($old_pkg_svc); + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } else { - my($error)=$new_pkg_svc->insert; - eidiot($error) if $error; + my $myerror = $new_pkg_svc->insert; + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } } -#$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart"); -#$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart"); -$req->cgi->redirect("../../browse/part_pkg.cgi"); +unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + $dbh->commit or die $dbh->errstr; + print $cgi->redirect(popurl(3). "browse/part_pkg.cgi"); +} else { + my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } ); + my %hash = $old_cust_pkg->hash; + $hash{'pkgpart'} = $pkgpart; + my($new_cust_pkg) = new FS::cust_pkg \%hash; + my $myerror = $new_cust_pkg->replace($old_cust_pkg); + if ( $myerror ) { + $dbh->rollback; + die "Error modifying cust_pkg record: $myerror\n"; + } + + $dbh->commit or die $dbh->errstr; + print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum); +} diff --git a/htdocs/edit/process/part_referral.cgi b/htdocs/edit/process/part_referral.cgi index 08a4c01d0..cde27ede1 100755 --- a/htdocs/edit/process/part_referral.cgi +++ b/htdocs/edit/process/part_referral.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/part_referral.cgi: Edit referrals (process form) +# $Id: part_referral.cgi,v 1.6 1999-02-07 09:59:28 ivan Exp $ # # ivan@sisd.com 98-feb-23 # @@ -8,38 +8,58 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_referral.cgi,v $ +# Revision 1.6 1999-02-07 09:59:28 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:56 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:47:57 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:30 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:25 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $refnum $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_referral qw(fields); -use FS::CGI qw(eidiot); -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearchs fields); +use FS::part_referral; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($refnum)=$req->param('refnum'); +$refnum = $cgi->param('refnum'); -my($new)=create FS::part_referral ( { +$new = new FS::part_referral ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('part_referral') } ); if ( $refnum ) { - my($old)=qsearchs('part_referral',{'refnum'=>$refnum}); - eidiot("(Old) Record not found!") unless $old; - my($error)=$new->replace($old); - eidiot($error) if $error; + my $old = qsearchs( 'part_referral', { 'refnum' =>$ refnum } ); + die "(Old) Record not found!" unless $old; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; } +$refnum=$new->refnum; -$refnum=$new->getfield('refnum'); -$req->cgi->redirect("../../browse/part_referral.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_referral.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/part_referral.cgi"); +} diff --git a/htdocs/edit/process/part_svc.cgi b/htdocs/edit/process/part_svc.cgi index 0f0fbc6e8..0b3e2cd1c 100755 --- a/htdocs/edit/process/part_svc.cgi +++ b/htdocs/edit/process/part_svc.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/part_svc.cgi: Edit service definitions (process form) +# $Id: part_svc.cgi,v 1.7 1999-02-07 09:59:29 ivan Exp $ # # ivan@sisd.com 97-nov-14 # @@ -8,40 +8,62 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: part_svc.cgi,v $ +# Revision 1.7 1999-02-07 09:59:29 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:57 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 22:47:58 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.4 1998/12/30 23:03:31 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 08:40:26 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.2 1998/11/21 06:43:08 ivan +# s/CGI::Request/CGI.pm/ +# use strict; -use CGI::Request; +use vars qw ( $cgi $svcpart $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); -use FS::part_svc qw(fields); -use FS::CGI qw(eidiot); - -my($req)=new CGI::Request; # create form object +use FS::Record qw(qsearchs fields); +use FS::part_svc; +use FS::CGI qw(popurl); -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($svcpart)=$req->param('svcpart'); +$svcpart = $cgi->param('svcpart'); -my($old)=qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; +$old = qsearchs('part_svc',{'svcpart'=>$svcpart}) if $svcpart; -my($new)=create FS::part_svc ( { +$new = new FS::part_svc ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); # } qw(svcpart svc svcdb) } fields('part_svc') } ); if ( $svcpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $svcpart=$new->getfield('svcpart'); } -#$req->cgi->redirect("../../view/part_svc.cgi?$svcpart"); -#$req->cgi->redirect("../../edit/part_svc.cgi?$svcpart"); -$req->cgi->redirect("../../browse/part_svc.cgi"); +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "part_svc.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3)."browse/part_svc.cgi"); +} diff --git a/htdocs/edit/process/svc_acct.cgi b/htdocs/edit/process/svc_acct.cgi index 8d77ba703..84f93abe8 100755 --- a/htdocs/edit/process/svc_acct.cgi +++ b/htdocs/edit/process/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_acct.cgi: Add/edit a customer (process form) +# $Id: svc_acct.cgi,v 1.7 1999-08-27 00:26:33 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi # -# Note: Should br run setuid root as user nobody. -# # ivan@voicenet.com 96-dec-18 # # Changed /u to /u2 @@ -21,67 +19,78 @@ # Changes to allow page to work at a relative position in server # Changed 'password' to '_password' because Pg6.3 reserves the password word # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.7 1999-08-27 00:26:33 ivan +# better error messages +# +# Revision 1.6 1999/02/28 00:03:45 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:30 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:13:58 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:47:59 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:27 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::CGI qw(popurl); +use FS::Record qw(qsearchs fields); use FS::svc_acct; -my($req) = new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; -my($old)=qsearchs('svc_acct',{'svcnum'=>$svcnum}) if $svcnum; +if ( $svcnum ) { + $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } ) + or die "fatal: can't find account (svcnum $svcnum)!"; +} else { + $old = ''; +} #unmunge popnum -$req->param('popnum', (split(/:/, $req->param('popnum') ))[0] ); +$cgi->param('popnum', (split(/:/, $cgi->param('popnum') ))[0] ); #unmunge passwd -if ( $req->param('_password') eq '*HIDDEN*' ) { - $req->param('_password',$old->getfield('_password')); +if ( $cgi->param('_password') eq '*HIDDEN*' ) { + die "fatal: no previous account to recall hidden password from!" unless $old; + $cgi->param('_password',$old->getfield('_password')); } -my($new) = create FS::svc_acct ( { +$new = new FS::svc_acct ( { map { - $_, $req->param($_); - } qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir - shell quota slipip) + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart username _password popnum uid gid finger dir + # shell quota slipip) + } ( fields('svc_acct'), qw( pkgnum svcpart ) ) } ); if ( $svcnum ) { - my($error) = $new->replace($old); - &idiot($error) if $error; + $error = $new->replace($old); } else { - my($error) = $new->insert; - &idiot($error) if $error; - $svcnum = $new->getfield('svcnum'); + $error = $new->insert; + $svcnum = $new->svcnum; } -#no errors, view account -$req->cgi->redirect("../../view/svc_acct.cgi?" . $svcnum ); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print < - - Error adding/updating account - - -

                    -

                    Error adding/updating account

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and submit the form again. - - -END - exit; +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "view/svc_acct.cgi?" . $svcnum ); } diff --git a/htdocs/edit/process/svc_acct_pop.cgi b/htdocs/edit/process/svc_acct_pop.cgi index 18d7940b4..763bca4a8 100755 --- a/htdocs/edit/process/svc_acct_pop.cgi +++ b/htdocs/edit/process/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/svc_acct_pop.cgi: Edit POP (process form) +# $Id: svc_acct_pop.cgi,v 1.6 1999-02-07 09:59:31 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,36 +8,59 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.6 1999-02-07 09:59:31 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.5 1999/01/19 05:13:59 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 22:48:00 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.3 1998/12/30 23:03:32 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.2 1998/12/17 08:40:28 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $popnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct_pop qw(fields); -use FS::CGI qw(eidiot); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_pop; +use FS::CGI qw(popurl); -my($req)=new CGI::Request; # create form object +$cgi = new CGI; # create form object -&cgisuidsetup($req->cgi); +&cgisuidsetup($cgi); -my($popnum)=$req->param('popnum'); +$popnum = $cgi->param('popnum'); -my($old)=qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; +$old = qsearchs('svc_acct_pop',{'popnum'=>$popnum}) if $popnum; -my($new)=create FS::svc_acct_pop ( { +$new = new FS::svc_acct_pop ( { map { - $_, $req->param($_); + $_, scalar($cgi->param($_)); } fields('svc_acct_pop') } ); if ( $popnum ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; + $error = $new->insert; $popnum=$new->getfield('popnum'); } -$req->cgi->redirect("../../browse/svc_acct_pop.cgi"); + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_pop.cgi?". $cgi->query_string ); +} else { + print $cgi->redirect(popurl(3). "browse/svc_acct_pop.cgi"); +} diff --git a/htdocs/edit/process/svc_acct_sm.cgi b/htdocs/edit/process/svc_acct_sm.cgi index 9ad546bf4..9c39bb8e5 100755 --- a/htdocs/edit/process/svc_acct_sm.cgi +++ b/htdocs/edit/process/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_acct_sm.cgi: Add/edit a mail alias (process form) +# $Id: svc_acct_sm.cgi,v 1.6 1999-02-28 00:03:46 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct_sm.cgi # -# Note: Should br run setuid root as user nobody. -# # lots of crufty stuff from svc_acct still in here, and modifications are (unelegantly) disabled. # # ivan@voicenet.com 97-jan-6 @@ -22,33 +20,53 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.6 1999-02-28 00:03:46 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:32 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:00 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:48:01 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:29 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $old $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearchs fields); use FS::svc_acct_sm; +use FS::CGI qw(popurl); -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum =$1; -my($old)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; +$old = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) if $svcnum; #unmunge domsvc and domuid -$req->param('domsvc',(split(/:/, $req->param('domsvc') ))[0] ); -$req->param('domuid',(split(/:/, $req->param('domuid') ))[0] ); +#$cgi->param('domsvc',(split(/:/, $cgi->param('domsvc') ))[0] ); +#$cgi->param('domuid',(split(/:/, $cgi->param('domuid') ))[0] ); -my($new) = create FS::svc_acct_sm ( { +$new = new FS::svc_acct_sm ( { map { - ($_, scalar($req->param($_))); - } qw(svcnum pkgnum svcpart domuser domuid domsvc) + ($_, scalar($cgi->param($_))); + #} qw(svcnum pkgnum svcpart domuser domuid domsvc) + } ( fields('svc_acct_sm'), qw( pkgnum svcpart ) ) } ); -my($error); if ( $svcnum ) { $error = $new->replace($old); } else { @@ -56,25 +74,10 @@ if ( $svcnum ) { $svcnum = $new->getfield('svcnum'); } -unless ($error) { - $req->cgi->redirect("../../view/svc_acct_sm.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_acct_sm.cgi?". $cgi->query_string ); } else { - CGI::Base::SendHeaders(); # one guess - print < - - Error adding/editing mail alias - - -

                    -

                    Error adding/editing mail alias

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and submit the form again. - - -END - + print $cgi->redirect(popurl(3). "view/svc_acct_sm.cgi?$svcnum"); } diff --git a/htdocs/edit/process/svc_domain.cgi b/htdocs/edit/process/svc_domain.cgi index 0782772dd..ad1892dd1 100755 --- a/htdocs/edit/process/svc_domain.cgi +++ b/htdocs/edit/process/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/svc_domain.cgi: Add a domain (process form) +# $Id: svc_domain.cgi,v 1.7 2001-04-23 07:12:44 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should br run setuid root as user nobody. -# # lots of yucky stuff in this one... bleachlkjhui! # # ivan@voicenet.com 97-jan-6 @@ -18,61 +16,65 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.7 2001-04-23 07:12:44 ivan +# better error message (if kludgy) for no referral +# remove outdated NSI foo from domain ordering. also, fuck NSI. +# +# Revision 1.6 1999/02/28 00:03:47 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:33 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:01 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1999/01/18 22:48:02 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.2 1998/12/17 08:40:30 ivan +# s/CGI::Request/CGI.pm/; etc +# use strict; -use CGI::Request; +use vars qw( $cgi $svcnum $new $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::Record qw(qsearchs fields); use FS::svc_domain; +use FS::CGI qw(popurl); #remove this to actually test the domains! $FS::svc_domain::whois_hack = 1; -my($req) = new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -$req->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; -my($svcnum)=$1; +$cgi->param('svcnum') =~ /^(\d*)$/ or die "Illegal svcnum!"; +$svcnum = $1; -my($new) = create FS::svc_domain ( { +$new = new FS::svc_domain ( { map { - $_, $req->param($_); - } qw(svcnum pkgnum svcpart domain action purpose) + $_, scalar($cgi->param($_)); + #} qw(svcnum pkgnum svcpart domain action purpose) + } ( fields('svc_domain'), qw( pkgnum svcpart action purpose ) ) } ); -my($error); -if ($req->param('legal') ne "Yes") { - $error = "Customer did not agree to be bound by NSI's ". - qq!!. - "Domain Name Resgistration Agreement"; -} elsif ($req->param('svcnum')) { +if ($cgi->param('svcnum')) { $error="Can't modify a domain!"; } else { $error=$new->insert; $svcnum=$new->svcnum; } -unless ($error) { - $req->cgi->redirect("../../view/svc_domain.cgi?$svcnum"); +if ($error) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "svc_domain.cgi?". $cgi->query_string ); } else { - CGI::Base::SendHeaders(); # one guess - print < - - Error adding domain - - -

                    -

                    Error adding domain

                    -
                    - Your update did not occur because of the following error: -

                    $error -

                    Hit the Back button in your web browser, correct this mistake, and submit the form again. - - -END - + print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum"); } - diff --git a/htdocs/edit/svc_acct.cgi b/htdocs/edit/svc_acct.cgi index 61d0fdc28..963bc1edf 100755 --- a/htdocs/edit/svc_acct.cgi +++ b/htdocs/edit/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_acct.cgi: Add/edit account (output form) +# $Id: svc_acct.cgi,v 1.10 1999-04-14 11:27:06 ivan Exp $ # # Usage: svc_acct.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 96-dec-18 # # rewrite ivan@sisd.com 98-mar-8 @@ -16,100 +14,139 @@ # bmccane@maxbaud.net 98-apr-3 # # use conf/shells and dbdef username length ivan@sisd.com 98-jul-13 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.10 1999-04-14 11:27:06 ivan +# showpasswords config option to show passwords +# +# Revision 1.9 1999/02/28 00:03:37 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/23 08:09:22 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.7 1999/02/07 09:59:22 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:43 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:32 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 23:03:22 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/17 06:17:08 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $conf $cgi @shells $action $svcnum $svc_acct $pkgnum $svcpart + $part_svc $svc $otaker $username $password $ulen $ulen2 $p1 + $popnum $uid $gid $finger $dir $shell $quota $slipip ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct qw(fields); - -my($shells)="/var/spool/freeside/conf/shells"; -open(SHELLS,$shells) or die "Can't open $shells: $!"; -my(@shells)=map { - /^([\/\w]*)$/ or die "Illegal shell in conf/shells!"; - $1; -} grep $_ !~ /^#/, ; - -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); - -my($action,$svcnum,$svc_acct,$pkgnum,$svcpart,$part_svc); +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct; +use FS::Conf; -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!"; +$cgi = new CGI; +&cgisuidsetup($cgi); - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; +$conf = new FS::Conf; +@shells = $conf->config('shells'); +if ( $cgi->param('error') ) { + $svc_acct = new FS::svc_acct ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct') + } ); + $svcnum = $svc_acct->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct=qsearchs('svc_acct',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct) svcnum!"; - $action="Edit"; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; -} else { #adding + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $svc_acct=create FS::svc_acct({}); + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$QUERY_STRING)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + } else { #adding - $svcnum=''; + $svc_acct = new FS::svc_acct({}); - #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') - ) ; - } + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; + + $svcnum=''; + + #set gecos + my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); + if ($cust_pkg) { + my($cust_main)=qsearchs('cust_main',{'custnum'=> $cust_pkg->custnum } ); + $svc_acct->setfield('finger', + $cust_main->getfield('first') . " " . $cust_main->getfield('last') + ) ; + } - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct') ) { - if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) { - $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) ); + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct') ) { + if ( $part_svc->getfield('svc_acct__'. $field. '_flag') ne '' ) { + $svc_acct->setfield($field,$part_svc->getfield('svc_acct__'. $field) ); + } } + } +} +$action = $svcnum ? 'Edit' : 'Add'; - $action="Add"; +$svc = $part_svc->getfield('svc'); -} +$otaker = getotaker; -my($svc)=$part_svc->getfield('svc'); +$username = $svc_acct->username; +if ( $svc_acct->_password ) { + if ( $conf->exists('showpasswords') ) { + $password = $svc_acct->_password; + } else { + $password = "*HIDDEN*"; + } +} else { + $password = ''; +} -my($otaker)=getotaker; +$ulen = $svc_acct->dbdef_table->column('username')->length; +$ulen2 = $ulen+2; -my($username,$password)=( - $svc_acct->username, - $svc_acct->_password ? "*HIDDEN*" : '', -); +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc account"); -my($ulen)=$svc_acct->dbdef_table->column('username')->length; -my($ulen2)=$ulen+2; +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -SendHeaders(); print < - - $action $svc account - - -

                    -

                    $action $svc account

                    -

                    - + @@ -121,7 +158,7 @@ Username: END #pop -my($popnum)=$svc_acct->popnum || 0; +$popnum = $svc_acct->popnum || 0; if ( $part_svc->svc_acct__popnum_flag eq "F" ) { print qq!!; } else { @@ -132,14 +169,14 @@ if ( $part_svc->svc_acct__popnum_flag eq "F" ) { $svc_acct_pop->popnum, ": ", $svc_acct_pop->city, ", ", $svc_acct_pop->state, - "(", $svc_acct_pop->ac, ")/", + " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "\n" ; } print ""; } -my($uid,$gid,$finger,$dir)=( +($uid,$gid,$finger,$dir)=( $svc_acct->uid, $svc_acct->gid, $svc_acct->finger, @@ -153,7 +190,7 @@ print < END -my($shell)=$svc_acct->shell; +$shell = $svc_acct->shell; if ( $part_svc->svc_acct__shell_flag eq "F" ) { print qq!!; } else { @@ -166,7 +203,7 @@ if ( $part_svc->svc_acct__shell_flag eq "F" ) { print ""; } -my($quota,$slipip)=( +($quota,$slipip)=( $svc_acct->quota, $svc_acct->slipip, ); @@ -180,7 +217,7 @@ if ( $part_svc->svc_acct__slipip_flag eq "F" ) { } #submit -print qq!

                    !; +print qq!

                    !; print < diff --git a/htdocs/edit/svc_acct_pop.cgi b/htdocs/edit/svc_acct_pop.cgi index 46d803f07..1797b2b8e 100755 --- a/htdocs/edit/svc_acct_pop.cgi +++ b/htdocs/edit/svc_acct_pop.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct_pop.cgi: Add/Edit pop (output form) +# $Id: svc_acct_pop.cgi,v 1.9 2000-01-28 23:02:48 ivan Exp $ # # ivan@sisd.com 98-mar-8 # @@ -8,38 +8,72 @@ # bmccane@maxbaud.net 98-apr-3 # # lose background, FS::CGI ivan@sisd.com 98-sep-2 +# +# $Log: svc_acct_pop.cgi,v $ +# Revision 1.9 2000-01-28 23:02:48 ivan +# track full phone number +# +# Revision 1.8 1999/02/23 08:09:23 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.7 1999/02/07 09:59:23 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:13:44 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:33 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 02:57:45 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:10 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/13 09:56:47 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base; +use vars qw( $cgi $svc_acct_pop $action $query $hashref $p1 ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); +use FS::Record qw(qsearch qsearchs fields); +use FS::CGI qw(header menubar popurl); use FS::svc_acct_pop; -use FS::CGI qw(header menubar); - -my($cgi) = new CGI::Base; -$cgi->get; - +$cgi = new CGI; &cgisuidsetup($cgi); -SendHeaders(); # one guess. - -my($svc_acct_pop,$action); -if ( $cgi->var('QUERY_STRING') =~ /^(\d+)$/ ) { #editing +if ( $cgi->param('error') ) { + $svc_acct_pop = new FS::svc_acct_pop ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_pop') + } ); +} elsif ( $cgi->keywords ) { #editing + my($query)=$cgi->keywords; + $query =~ /^(\d+)$/; $svc_acct_pop=qsearchs('svc_acct_pop',{'popnum'=>$1}); - $action='Edit'; } else { #adding - $svc_acct_pop=create FS::svc_acct_pop {}; - $action='Add'; + $svc_acct_pop = new FS::svc_acct_pop {}; } -my($hashref)=$svc_acct_pop->hashref; +$action = $svc_acct_pop->popnum ? 'Edit' : 'Add'; +$hashref = $svc_acct_pop->hashref; -print header("$action POP", menubar( - 'Main Menu' => '../', - 'View all POPs' => "../browse/svc_acct_pop.cgi", -)), < -END +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action POP", menubar( + 'Main Menu' => popurl(2), + 'View all POPs' => popurl(2). "browse/svc_acct_pop.cgi", +)); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); + +print qq!!; #display @@ -49,9 +83,10 @@ print qq!!, print < City -State +State Area Code Exchange +Local

                    END diff --git a/htdocs/edit/svc_acct_sm.cgi b/htdocs/edit/svc_acct_sm.cgi index 45a8eb8fc..cb7cbfae0 100755 --- a/htdocs/edit/svc_acct_sm.cgi +++ b/htdocs/edit/svc_acct_sm.cgi @@ -1,14 +1,12 @@ #!/usr/bin/perl -Tw # -# svc_acct_sm.cgi: Add/edit a mail alias (output form) +# $Id: svc_acct_sm.cgi,v 1.9 1999-02-28 00:03:38 ivan Exp $ # # Usage: svc_acct_sm.cgi {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_acct_sm.cgi? {svcnum} | pkgnum{pkgnum}-svcpart{svcpart} # # use {svcnum} for edit, pkgnum{pkgnum}-svcpart{svcpart} for add # -# Note: Should be run setuid freeside as user nobody. -# # should error out in a more CGI-friendly way, and should have more error checking (sigh). # # ivan@voicenet.com 97-jan-5 @@ -33,71 +31,102 @@ # rewrite ivan@sisd.com 98-mar-15 # # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-26 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.9 1999-02-28 00:03:38 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/07 09:59:24 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:45 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:34 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:24 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/23 02:58:45 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:11 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/12/16 05:19:15 ivan +# use FS::Conf +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $conf $cgi $mydomain $action $svcnum $svc_acct_sm $pkgnum $svcpart + $part_svc $query %username %domain $p1 $domuser $domsvc $domuid ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct_sm qw(fields); - -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1 -} grep $_ !~ /^(#|$)/, ; -close DOMAIN; - -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); - -SendHeaders(); # one guess. +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_acct_sm; +use FS::Conf; -my($action,$svcnum,$svc_acct_sm,$pkgnum,$svcpart,$part_svc); -if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) - or die "Unknown (svc_acct_sm) svcnum!"; +$cgi = new CGI; +&cgisuidsetup($cgi); - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; - +if ( $cgi->param('error') ) { + $svc_acct_sm = new FS::svc_acct_sm ( { + map { $_, scalar($cgi->param($_)) } fields('svc_acct_sm') + } ); + $svcnum = $svc_acct_sm->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; +} else { + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_acct_sm=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}) + or die "Unknown (svc_acct_sm) svcnum!"; - $action="Edit"; - -} else { #adding + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $svc_acct_sm=create FS::svc_acct_sm({}); + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; + + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + } else { #adding - $svcnum=''; + $svc_acct_sm = new FS::svc_acct_sm({}); - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_acct_sm') ) { - if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { - $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; } - } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $action='Add'; + $svcnum=''; + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_acct_sm') ) { + if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') ne '' ) { + $svc_acct_sm->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) ); + } + } + + } } +$action = $svc_acct_sm->svcnum ? 'Edit' : 'Add'; -my(%username,%domain); if ($pkgnum) { #find all possible uids (and usernames) @@ -155,17 +184,14 @@ if ($pkgnum) { die "\$action eq Add, but \$pkgnum is null!\n"; } -print < - - Mail Alias $action - - -
                    -

                    Mail Alias $action

                    -
                    - -END +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("Mail Alias $action", ''); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); + +print qq!!; #display @@ -182,7 +208,7 @@ print qq!!; #svcpart print qq!!; -my($domuser,$domsvc,$domuid)=( +($domuser,$domsvc,$domuid)=( $svc_acct_sm->domuser, $svc_acct_sm->domsvc, $svc_acct_sm->domuid, @@ -194,14 +220,16 @@ print qq!\n\nMail to ( * #domsvc print qq! \@ "; #uid print qq!\nforwards to \@$mydomain mailbox."; diff --git a/htdocs/edit/svc_domain.cgi b/htdocs/edit/svc_domain.cgi index 0717a2c09..49be88073 100755 --- a/htdocs/edit/svc_domain.cgi +++ b/htdocs/edit/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_domain.cgi: Add domain (output form) +# $Id: svc_domain.cgi,v 1.10 2001-04-23 07:12:44 ivan Exp $ # # Usage: svc_domain.cgi pkgnum{pkgnum}-svcpart{svcpart} # http://server.name/path/svc_domain.cgi?pkgnum{pkgnum}-svcpart{svcpart} # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 97-jan-5 -> 97-jan-6 # # changes for domain template 3.5 @@ -15,92 +13,137 @@ # rewrite ivan@sisd.com 98-mar-14 # # no GOV in instructions ivan@sisd.com 98-jul-17 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.10 2001-04-23 07:12:44 ivan +# better error message (if kludgy) for no referral +# remove outdated NSI foo from domain ordering. also, fuck NSI. +# +# Revision 1.9 1999/02/28 00:03:39 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/07 09:59:25 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:46 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:35 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/30 23:03:25 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/23 03:00:16 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 06:17:12 ivan +# fix double // in relative URLs, s/CGI::Base/CGI/; +# +# Revision 1.2 1998/11/13 09:56:48 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $action $svcnum $svc_domain $pkgnum $svcpart $part_svc + $svc $otaker $domain $p1 $kludge_action $purpose ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup getotaker); -use FS::Record qw(qsearch qsearchs); -use FS::svc_domain qw(fields); +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::svc_domain; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); -my($action,$svcnum,$svc_domain,$pkgnum,$svcpart,$part_svc); - -if ( $QUERY_STRING =~ /^(\d+)$/ ) { #editing - - $svcnum=$1; - $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) - or die "Unknown (svc_domain) svcnum!"; - - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) - or die "Unknown (cust_svc) svcnum!"; +if ( $cgi->param('error') ) { + $svc_domain = new FS::svc_domain ( { + map { $_, scalar($cgi->param($_)) } fields('svc_domain') + } ); + $svcnum = $svc_domain->svcnum; + $pkgnum = $cgi->param('pkgnum'); + $svcpart = $cgi->param('svcpart'); + $kludge_action = $cgi->param('action'); + $purpose = $cgi->param('purpose'); + $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); + die "No part_svc entry!" unless $part_svc; +} else { + $kludge_action = ''; + $purpose = ''; + my($query) = $cgi->keywords; + if ( $query =~ /^(\d+)$/ ) { #editing + $svcnum=$1; + $svc_domain=qsearchs('svc_domain',{'svcnum'=>$svcnum}) + or die "Unknown (svc_domain) svcnum!"; - $pkgnum=$cust_svc->pkgnum; - $svcpart=$cust_svc->svcpart; + my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}) + or die "Unknown (cust_svc) svcnum!"; - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + $pkgnum=$cust_svc->pkgnum; + $svcpart=$cust_svc->svcpart; - $action="Edit"; + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; -} else { #adding + } else { #adding - $svc_domain=create FS::svc_domain({}); + $svc_domain = new FS::svc_domain({}); - foreach $_ (split(/-/,$QUERY_STRING)) { - $pkgnum=$1 if /^pkgnum(\d+)$/; - $svcpart=$1 if /^svcpart(\d+)$/; - } - $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); - die "No part_svc entry!" unless $part_svc; + foreach $_ (split(/-/,$query)) { + $pkgnum=$1 if /^pkgnum(\d+)$/; + $svcpart=$1 if /^svcpart(\d+)$/; + } + $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); + die "No part_svc entry!" unless $part_svc; - $svcnum=''; + $svcnum=''; - #set fixed and default fields from part_svc - my($field); - foreach $field ( fields('svc_domain') ) { - if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { - $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + #set fixed and default fields from part_svc + my($field); + foreach $field ( fields('svc_domain') ) { + if ( $part_svc->getfield('svc_domain__'. $field. '_flag') ne '' ) { + $svc_domain->setfield($field,$part_svc->getfield('svc_domain__'. $field) ); + } } + } +} +$action = $svcnum ? 'Edit' : 'Add'; - $action="Add"; +$svc = $part_svc->getfield('svc'); -} +$otaker = getotaker; -my($svc)=$part_svc->getfield('svc'); +$domain = $svc_domain->domain; -my($otaker)=getotaker; +$p1 = popurl(1); +print $cgi->header( '-expires' => 'now' ), header("$action $svc", ''); -my($domain)=( - $svc_domain->domain, -); +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); -SendHeaders(); print < - - $action $svc - - -
                    -

                    $action $svc

                    -

                    - + - New -
                    Transfer +END -

                    Customer agrees to be bound by NSI's - -Domain Name Registration Agreement - +print qq!New!; +print qq!
                    Transfer!; + +print <Domain -
                    Purpose/Description: +
                    Purpose/Description:

                    • COM is for commercial, for-profit organziations @@ -112,7 +155,8 @@ Domain Name Registration Agreement
                    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. -

                    GOV registrations are limited to top-level US Federal Government agencies (see RFC 1816). + diff --git a/htdocs/images/mid-logo.gif b/htdocs/images/mid-logo.gif deleted file mode 100644 index 4ceb3add5..000000000 Binary files a/htdocs/images/mid-logo.gif and /dev/null differ diff --git a/htdocs/images/mid-logo.png b/htdocs/images/mid-logo.png new file mode 100644 index 000000000..d993419cc Binary files /dev/null and b/htdocs/images/mid-logo.png differ diff --git a/htdocs/images/sisd.jpg b/htdocs/images/sisd.jpg deleted file mode 100755 index 908a5eaff..000000000 Binary files a/htdocs/images/sisd.jpg and /dev/null differ diff --git a/htdocs/images/small-logo.gif b/htdocs/images/small-logo.gif deleted file mode 100644 index a8e9c5763..000000000 Binary files a/htdocs/images/small-logo.gif and /dev/null differ diff --git a/htdocs/images/small-logo.png b/htdocs/images/small-logo.png new file mode 100644 index 000000000..406a36980 Binary files /dev/null and b/htdocs/images/small-logo.png differ diff --git a/htdocs/index.html b/htdocs/index.html index de0667e59..bee44a2f7 100755 --- a/htdocs/index.html +++ b/htdocs/index.html @@ -8,22 +8,23 @@

                    - Silicon Interactive Software Design + Silicon Interactive Software Design

                    freeside main menu
                    - Information + Freeside home page
                    Documentation


                    -

                    New Customer

                    -

                    Search

                    - + -

                    Browse

                    - -
                  • customers (by customer number) -
                  • customers (by last name) -
                  • customers (by company) -
                  • packages (by package number) -
                  • packages with unconfigured services (by package number) -
                  • accounts (by service number) -
                  • accounts (by username) -
                  • accounts (by uid) -
                  • unlinked accounts (by service number) -
                  • unlinked accounts (by username) -
                  • unlinked accounts (by uid) -
                  • domains (by service number) -
                  • domains (by domain) -
                  • unlinked domains (by service number) -
                  • unlinked domains (by domain) -
                  • -

                    Administration

                    - +
                  +
                • Browse + +
                • Administration +
                  • - View/Edit services + View/Edit service definitions - Services are items you offer to your customers.
                  • - View/Edit packages + View/Edit package definitions - One or more services are grouped together into a package and given pricing information. Customers purchase packages, not @@ -66,31 +78,28 @@
                  • View/Edit agent types - - Agent types define groups of packages that you can then assign - to particular agents. + - Agent types define groups of package definitions that you can + then assign to particular agents.
                  • View/Edit agents - Agents are resellers of your service. Agents may be limited - to a subset of your full offerings (via their agent type). -
                    + to a subset of your full offerings (via their type).
                  • View/Edit referrals - Where a customer heard about your service. Tracked for informational purposes. -
                  • View/Edit locales and tax rates - - Change tax rates by state, or break down a state into counties - and assign different tax rates to each county. -
                    + - Change tax rates, or break down a country into states, or a state + into counties and assign different tax rates to each.
                  • View/Edit POPs - Points of Presence - - +
                  +
                diff --git a/htdocs/misc/bill.cgi b/htdocs/misc/bill.cgi index d41f6d1c9..52323ba59 100755 --- a/htdocs/misc/bill.cgi +++ b/htdocs/misc/bill.cgi @@ -1,36 +1,50 @@ #!/usr/bin/perl -Tw # +# $Id: bill.cgi,v 1.5 1999-08-12 04:32:21 ivan Exp $ +# # s/FS:Search/FS::Record/ and cgisuidsetup($cgi) ivan@sisd.com 98-mar-13 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: bill.cgi,v $ +# Revision 1.5 1999-08-12 04:32:21 ivan +# hidecancelledcustomers +# +# Revision 1.4 1999/01/19 05:14:02 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:01:13 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:41 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $query $custnum $cust_main $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); -use FS::Bill; +use FS::cust_main; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint custnum -$QUERY_STRING =~ /^(\d*)$/; -my($custnum)=$1; -my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); +($query) = $cgi->keywords; +$query =~ /^(\d*)$/; +$custnum = $1; +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); die "Can't find customer!\n" unless $cust_main; -# ? -bless($cust_main,"FS::Bill"); - -my($error); - $error = $cust_main->bill( # 'time'=>$time ); -&idiot($error) if $error; +&eidiot($error) if $error; $error = $cust_main->collect( # 'invoice-time'=>$time, @@ -38,29 +52,7 @@ $error = $cust_main->collect( 'batch_card'=> 'no', 'report_badcard'=> 'yes', ); -&idiot($error) if $error; - -$cgi->redirect("../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print < - - Error billing customer - - -
                -

                Error billing customer

                -
                - Your update did not occur because of the following error: -

                $error - - -END - - exit; +&eidiot($error) if $error; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum"); diff --git a/htdocs/misc/cancel-unaudited.cgi b/htdocs/misc/cancel-unaudited.cgi index 929274f38..319ac5526 100755 --- a/htdocs/misc/cancel-unaudited.cgi +++ b/htdocs/misc/cancel-unaudited.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cancel-unaudited.cgi: Cancel an unaudited account +# $Id: cancel-unaudited.cgi,v 1.8 2001-04-09 23:05:16 ivan Exp $ # # Usage: cancel-unaudited.cgi svcnum # http://server.name/path/cancel-unaudited.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # ivan@voicenet.com 97-apr-23 # # rewrote for new API @@ -16,31 +14,57 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cancel-unaudited.cgi,v $ +# Revision 1.8 2001-04-09 23:05:16 ivan +# Transactions Part I!!! +# +# Revision 1.7 2000/06/15 12:30:37 ivan +# bugfix from Jeff Finucane, thanks! +# +# Revision 1.6 1999/02/28 00:03:48 ivan +# removed misleading comments +# +# Revision 1.5 1999/02/07 09:59:34 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:03 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:02:05 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:42 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi $query $svcnum $svc_acct $cust_svc $error $dbh ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); use FS::cust_svc; use FS::svc_acct; -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); +$cgi = new CGI; +$dbh = &cgisuidsetup($cgi); #untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; -my($svc_acct) = qsearchs('svc_acct',{'svcnum'=>$svcnum}); -&idiot("Unknown svcnum!") unless $svc_acct; +$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum}); +die "Unknown svcnum!" unless $svc_acct; -my($cust_svc) = qsearchs('cust_svc',{'svcnum'=>$svcnum}); -&idiot(qq!This account has already been audited. Cancel the - getfield('pkgnum') . qq!pkgnum"> package instead.!) - if $cust_svc->getfield('pkgnum') ne ''; + if $cust_svc->pkgnum ne '' && $cust_svc->pkgnum ne '0'; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -48,38 +72,22 @@ local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; -my($error); +local $FS::UID::AutoCommit = 0; -bless($svc_acct,"FS::svc_acct"); $error = $svc_acct->cancel; -&idiot($error) if $error; +&myeidiot($error) if $error; $error = $svc_acct->delete; -&idiot($error) if $error; +&myeidiot($error) if $error; -bless($cust_svc,"FS::cust_svc"); $error = $cust_svc->delete; -&idiot($error) if $error; +&myeidiot($error) if $error; + +$dbh->commit or die $dbh->errstr; -$cgi->redirect("../"); +print $cgi->redirect(popurl(2)); -sub idiot { - my($error)=@_; - SendHeaders(); - print < - - Error cancelling account - - -

                -

                Error cancelling account

                -
                -
                - There has been an error cancelling this acocunt: $error - - - -END - exit; +sub myeidiot { + $dbh->rollback; + &eidiot(@_); } diff --git a/htdocs/misc/cancel_pkg.cgi b/htdocs/misc/cancel_pkg.cgi index 6702a0351..7bbcf6e7f 100755 --- a/htdocs/misc/cancel_pkg.cgi +++ b/htdocs/misc/cancel_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cancel_pkg.cgi: Cancel a package +# $Id: cancel_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $ # # Usage: cancel_pkg.cgi pkgnum # http://server.name/path/cancel_pkg.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # IT DOESN'T RUN THE APPROPRIATE PROGRAMS YET!!!! # # probably should generalize this to do cancels, suspensions, unsuspensions, etc. @@ -27,28 +25,47 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cancel_pkg.cgi,v $ +# Revision 1.6 1999-04-08 10:35:02 ivan +# import necessary subroutines from FS::CGI +# +# Revision 1.5 1999/02/28 00:03:49 ivan +# removed misleading comments +# +# Revision 1.4 1999/01/19 05:14:04 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:02:54 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:43 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw ( $cgi $query $pkgnum $cust_pkg $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(eidiot popurl); use FS::Record qw(qsearchs); +use FS::CGI qw(popurl eidiot); use FS::cust_pkg; -use FS::CGI qw(idiot); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum"; -my($pkgnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/ || die "Illegal pkgnum"; +$pkgnum = $1; -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -bless($cust_pkg,'FS::cust_pkg'); -my($error)=$cust_pkg->cancel; -idiot($error) if $error; +$error = $cust_pkg->cancel; +eidiot($error) if $error; -$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/misc/delete-customer.cgi b/htdocs/misc/delete-customer.cgi new file mode 100755 index 000000000..8addbd657 --- /dev/null +++ b/htdocs/misc/delete-customer.cgi @@ -0,0 +1,58 @@ +#!/usr/bin/perl -Tw +# +# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $ +# +# $Log: delete-customer.cgi,v $ +# Revision 1.1 1999-04-15 16:44:36 ivan +# delete customers +# + +use strict; +use vars qw( $cgi $conf $query $custnum $new_custnum $cust_main ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; + +$cgi = new CGI; +cgisuidsetup($cgi); + +$conf = new FS::Conf; +die "Customer deletions not enabled" unless $conf->exists('deletecustomers'); + +if ( $cgi->param('error') ) { + $custnum = $cgi->param('custnum'); + $new_custnum = $cgi->param('new_custnum'); +} else { + ($query) = $cgi->keywords; + $query =~ /^(\d+)$/ or die "Illegal query: $query"; + $custnum = $1; + $new_custnum = ''; +} +$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } ) + or die "Customer not found: $custnum"; + +print $cgi->header ( '-expires' => 'now' ), header('Delete customer'); + +print qq!Error: !, $cgi->param('error'), + "" + if $cgi->param('error'); + +print + qq!
                !, + qq!!; + +if ( qsearch('cust_pkg', { 'custnum' => $custnum, 'cancel' => '' } ) ) { + print "Move uncancelled packages to customer number ", + qq!

                !; +} + +print <completely remove
                all traces of this customer record. +
                Are you absolutely sure you want to delete this customer? +
                +
                +END + diff --git a/htdocs/misc/expire_pkg.cgi b/htdocs/misc/expire_pkg.cgi index 163516627..cf1f23153 100755 --- a/htdocs/misc/expire_pkg.cgi +++ b/htdocs/misc/expire_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# expire_pkg.cgi: Expire a package +# $Id: expire_pkg.cgi,v 1.4 1999-02-28 00:03:50 ivan Exp $ # # Usage: post form to: # http://server.name/path/expire_pkg.cgi # -# Note: Should be run setuid freeside as user nobody -# # based on susp_pkg # ivan@voicenet.com 97-jul-29 # @@ -14,58 +12,50 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: expire_pkg.cgi,v $ +# Revision 1.4 1999-02-28 00:03:50 ivan +# removed misleading comments +# +# Revision 1.3 1999/01/19 05:14:05 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.2 1998/12/17 09:12:44 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; +use vars qw ( $cgi $date $pkgnum $cust_pkg %hash $new $error ); use Date::Parse; -use CGI::Request; +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); use FS::cust_pkg; -my($req) = new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); #untaint date & pkgnum -my($date); -if ( $req->param('date') ) { - str2time($req->param('date')) =~ /^(\d+)$/ or die "Illegal date"; +if ( $cgi->param('date') ) { + str2time($cgi->param('date')) =~ /^(\d+)$/ or die "Illegal date"; $date=$1; } else { $date=''; } -$req->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum"; -my($pkgnum)=$1; +$cgi->param('pkgnum') =~ /^(\d+)$/ or die "Illegal pkgnum"; +$pkgnum = $1; -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -my(%hash)=$cust_pkg->hash; +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +%hash = $cust_pkg->hash; $hash{expire}=$date; -my($new)=create FS::cust_pkg ( \%hash ); -my($error) = $new->replace($cust_pkg); -&idiot($error) if $error; - -$req->cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +$new = new FS::cust_pkg ( \%hash ); +$error = $new->replace($cust_pkg); +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print < - - Error expiring package - - -
                -

                Error expiring package

                -
                -
                - There has been an error expiring this package: $error - - - -END - exit; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/misc/link.cgi b/htdocs/misc/link.cgi index d1db000ec..eb1780711 100755 --- a/htdocs/misc/link.cgi +++ b/htdocs/misc/link.cgi @@ -1,21 +1,45 @@ #!/usr/bin/perl -Tw # -# link: instead of adding a new account, link to an existing. (output form) -# -# Note: Should be run setuid freeside as user nobody +# $Id: link.cgi,v 1.7 1999-04-08 11:31:40 ivan Exp $ # # ivan@voicenet.com 97-feb-5 # # rewrite ivan@sisd.com 98-mar-17 # # can also link on some other fields now (about time) ivan@sisd.com 98-jun-24 +# +# $Log: link.cgi,v $ +# Revision 1.7 1999-04-08 11:31:40 ivan +# *** empty log message *** +# +# Revision 1.6 1999/02/28 00:03:51 ivan +# removed misleading comments +# +# Revision 1.5 1999/01/19 05:14:06 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:36 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/23 03:03:39 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:45 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw ( %link_field $cgi $pkgnum $svcpart $query $part_svc $svc $svcdb + $link_field ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl header); use FS::Record qw(qsearchs); -my(%link_field)=( +%link_field = ( 'svc_acct' => 'username', 'svc_domain' => 'domain', 'svc_acct_sm' => '', @@ -23,33 +47,22 @@ my(%link_field)=( 'svc_wo' => '', ); -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -my($pkgnum,$svcpart); -foreach $_ (split(/-/,$QUERY_STRING)) { #get & untaint pkgnum & svcpart +($query) = $cgi->keywords; +foreach $_ (split(/-/,$query)) { #get & untaint pkgnum & svcpart $pkgnum=$1 if /^pkgnum(\d+)$/; $svcpart=$1 if /^svcpart(\d+)$/; } -my($part_svc) = qsearchs('part_svc',{'svcpart'=>$svcpart}); -my($svc) = $part_svc->getfield('svc'); -my($svcdb) = $part_svc->getfield('svcdb'); -my($link_field) = $link_field{$svcdb}; +$part_svc = qsearchs('part_svc',{'svcpart'=>$svcpart}); +$svc = $part_svc->getfield('svc'); +$svcdb = $part_svc->getfield('svcdb'); +$link_field = $link_field{$svcdb}; -CGI::Base::SendHeaders(); -print < - - Link to existing $svc account - - -
                -

                Link to existing $svc account

                -

                -
                -END +print $cgi->header( '-expires' => 'now' ), header("Link to existing $svc"), + qq!!; if ( $link_field ) { print <keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:47 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw($conf $cgi $lpr $query $invnum $cust_bill $custnum ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl); use FS::Record qw(qsearchs); -use FS::Invoice; - -my($lpr) = "|lpr -h"; +use FS::cust_bill; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); +$conf = new FS::Conf; +$lpr = $conf->config('lpr'); + #untaint invnum -$QUERY_STRING =~ /^(\d*)$/; -my($invnum)=$1; -my($cust_bill)=qsearchs('cust_bill',{'invnum'=>$invnum}); +($query) = $cgi->keywords; +$query =~ /^(\d*)$/; +$invnum = $1; +$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum}); die "Can't find invoice!\n" unless $cust_bill; - bless($cust_bill,"FS::Invoice"); - open(LPR,$lpr) or die "Can't open $lpr: $!"; + open(LPR,"|$lpr") or die "Can't open $lpr: $!"; print LPR $cust_bill->print_text; #( date ) close LPR or die $! ? "Error closing $lpr: $!" : "Exit status $? from $lpr"; -my($custnum)=$cust_bill->getfield('custnum'); - -$cgi->redirect("../view/cust_main.cgi?$custnum#history"); - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); # one guess - print < - - Error printing invoice - - -
                -

                Error printing invoice

                -
                - Your update did not occur because of the following error: -

                $error - - -END - - exit; - -} +$custnum = $cust_bill->getfield('custnum'); + +print $cgi->redirect(popurl(2). "view/cust_main.cgi?$custnum#history"); diff --git a/htdocs/misc/process/delete-customer.cgi b/htdocs/misc/process/delete-customer.cgi new file mode 100755 index 000000000..0a939c559 --- /dev/null +++ b/htdocs/misc/process/delete-customer.cgi @@ -0,0 +1,46 @@ +#!/usr/bin/perl -Tw +# +# $Id: delete-customer.cgi,v 1.1 1999-04-15 16:44:36 ivan Exp $ +# +# $Log: delete-customer.cgi,v $ +# Revision 1.1 1999-04-15 16:44:36 ivan +# delete customers +# + +use strict; +use vars qw ( $cgi $conf $custnum $new_custnum $cust_main $error ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use FS::UID qw(cgisuidsetup); +use FS::Record qw(qsearchs); +use FS::CGI qw(popurl); +use FS::cust_main; + +$cgi = new CGI; +cgisuidsetup($cgi); + +$conf = new FS::Conf; +die "Customer deletions not enabled" unless $conf->exists('deletecustomers'); + +$cgi->param('custnum') =~ /^(\d+)$/; +$custnum = $1; +if ( $cgi->param('new_custnum') ) { + $cgi->param('new_custnum') =~ /^(\d+)$/ + or die "Illegal new customer number: ". $cgi->param('new_custnum'); + $new_custnum = $1; +} else { + $new_custnum = ''; +} +$cust_main = qsearchs( 'cust_main', { 'custnum' => $custnum } ) + or die "Customer not found: $custnum"; + +$error = $cust_main->delete($new_custnum); + +if ( $error ) { + $cgi->param('error', $error); + print $cgi->redirect(popurl(2). "delete-customer.cgi?". $cgi->query_string ); +} elsif ( $new_custnum ) { + print $cgi->redirect(popurl(3). "view/cust_main.cgi?$new_custnum"); +} else { + print $cgi->redirect(popurl(3)); +} diff --git a/htdocs/misc/process/link.cgi b/htdocs/misc/process/link.cgi index 23fb05386..7d6bd506f 100755 --- a/htdocs/misc/process/link.cgi +++ b/htdocs/misc/process/link.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# process/link.cgi: link to existing customer (process form) +# $Id: link.cgi,v 1.6 2000-07-17 17:59:33 ivan Exp $ # # ivan@voicenet.com 97-feb-5 # @@ -10,64 +10,67 @@ # bmccane@maxbaud.net 98-apr-3 # # can also link on some other fields now (about time) ivan@sisd.com 98-jun-24 +# +# $Log: link.cgi,v $ +# Revision 1.6 2000-07-17 17:59:33 ivan +# oops +# +# Revision 1.5 1999/04/15 14:09:17 ivan +# get rid of top-level my() variables +# +# Revision 1.4 1999/02/07 09:59:35 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.3 1999/01/19 05:14:10 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.2 1998/12/17 09:15:00 ivan +# s/CGI::Request/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi $old $new $error $pkgnum $svcpart $svcnum ); +use CGI; use CGI::Carp qw(fatalsToBrowser); -use FS::CGI qw(idiot); +use FS::CGI qw(popurl idiot eidiot); use FS::UID qw(cgisuidsetup); use FS::cust_svc; use FS::Record qw(qsearchs); -my($req)=new CGI::Request; # create form object -cgisuidsetup($req->cgi); - -#$req->import_names('R'); #import CGI variables into package 'R'; +$cgi = new CGI; +cgisuidsetup($cgi); -$req->param('pkgnum') =~ /^(\d+)$/; my($pkgnum)=$1; -$req->param('svcpart') =~ /^(\d+)$/; my($svcpart)=$1; +$cgi->param('pkgnum') =~ /^(\d+)$/; +$pkgnum = $1; +$cgi->param('svcpart') =~ /^(\d+)$/; +$svcpart = $1; +$cgi->param('svcnum') =~ /^(\d*)$/; +$svcnum = $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; + $cgi->param('link_field') =~ /^(\w+)$/; my($link_field)=$1; + my($svc_acct)=qsearchs($svcdb,{$link_field => $cgi->param('link_value') }); + eidiot("$link_field not found!") unless $svc_acct; $svcnum=$svc_acct->svcnum; } -my($old)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$old = qsearchs('cust_svc',{'svcnum'=>$svcnum}); die "svcnum not found!" unless $old; -my($new)=create FS::cust_svc ({ +$new = new FS::cust_svc ({ 'svcnum' => $svcnum, 'pkgnum' => $pkgnum, 'svcpart' => $svcpart, }); -my($error); $error = $new->replace($old); unless ($error) { #no errors, so let's view this customer. - $req->cgi->redirect("../../view/cust_pkg.cgi?$pkgnum"); + print $cgi->redirect(popurl(3). "view/cust_pkg.cgi?$pkgnum"); } else { - CGI::Base::SendHeaders(); # one guess - print < - - Error - - -

                -

                Error

                -
                - Your update did not occur because of the following error: -

                $error -

                Hit the Back button in your web browser, correct this mistake, and submit the form again. - - -END - + idiot($error); } diff --git a/htdocs/misc/susp_pkg.cgi b/htdocs/misc/susp_pkg.cgi index 7b23caeb2..abe4f70b0 100755 --- a/htdocs/misc/susp_pkg.cgi +++ b/htdocs/misc/susp_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# susp_pkg.cgi: Suspend a package +# $Id: susp_pkg.cgi,v 1.6 1999-04-08 10:35:02 ivan Exp $ # # Usage: susp_pkg.cgi pkgnum # http://server.name/path/susp_pkg.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # probably should generalize this to do cancels, suspensions, unsuspensions, etc. # # ivan@voicenet.com 97-feb-27 @@ -21,48 +19,46 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: susp_pkg.cgi,v $ +# Revision 1.6 1999-04-08 10:35:02 ivan +# import necessary subroutines from FS::CGI +# +# Revision 1.5 1999/02/28 00:03:52 ivan +# removed misleading comments +# +# Revision 1.4 1999/01/19 05:14:08 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:04:56 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:48 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi $query $pkgnum $cust_pkg $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearchs); +use FS::CGI qw(popurl eidiot); use FS::cust_pkg; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum"; -my($pkgnum)=$1; - -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +($query) = $cgi->keywords; +$query =~ /^(\d+)$/ || die "Illegal pkgnum"; +$pkgnum = $1; -bless($cust_pkg,'FS::cust_pkg'); -my($error)=$cust_pkg->suspend; -&idiot($error) if $error; +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +$error = $cust_pkg->suspend; +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print < - - Error suspending package - - -

                -

                Error suspending package

                -
                -
                - There has been an error suspending this package: $error - - - -END - exit; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/misc/unsusp_pkg.cgi b/htdocs/misc/unsusp_pkg.cgi index 2f340c6fa..9e60064c3 100755 --- a/htdocs/misc/unsusp_pkg.cgi +++ b/htdocs/misc/unsusp_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# susp_pkg.cgi: Unsuspend a package +# $Id: unsusp_pkg.cgi,v 1.5 1999-02-28 00:03:53 ivan Exp $ # # Usage: susp_pkg.cgi pkgnum # http://server.name/path/susp_pkg.cgi pkgnum # -# Note: Should be run setuid freeside as user nobody -# # probably should generalize this to do cancels, suspensions, unsuspensions, etc. # # ivan@voicenet.com 97-feb-27 @@ -21,48 +19,43 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: unsusp_pkg.cgi,v $ +# Revision 1.5 1999-02-28 00:03:53 ivan +# removed misleading comments +# +# Revision 1.4 1999/01/19 05:14:09 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:05:25 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:12:49 ivan +# s/CGI::(Request|Base)/CGI.pm/; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use vars qw( $cgi $query $pkgnum $cust_pkg $error ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl eidiot); use FS::Record qw(qsearchs); use FS::cust_pkg; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/ || die "Illegal pkgnum"; -my($pkgnum)=$1; - -my($cust_pkg) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +($query) = $cgi->keywords; +$query =~ /^(\d+)$/ || die "Illegal pkgnum"; +$pkgnum = $1; -bless($cust_pkg,'FS::cust_pkg'); -my($error)=$cust_pkg->unsuspend; -&idiot($error) if $error; +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); -$cgi->redirect("../view/cust_main.cgi?".$cust_pkg->getfield('custnum')); +$error = $cust_pkg->unsuspend; +&eidiot($error) if $error; -sub idiot { - my($error)=@_; - SendHeaders(); - print < - - Error unsuspending package - - -
                -

                Error unsuspending package

                -
                -
                - There has been an error unsuspending this package: $error - - - -END - exit; -} +print $cgi->redirect(popurl(2). "view/cust_main.cgi?".$cust_pkg->getfield('custnum')); diff --git a/htdocs/search/cust_bill.cgi b/htdocs/search/cust_bill.cgi index 5be84b79e..0645d1cc0 100755 --- a/htdocs/search/cust_bill.cgi +++ b/htdocs/search/cust_bill.cgi @@ -1,46 +1,176 @@ #!/usr/bin/perl -Tw # -# cust_bill.cgi: Search for invoices (process form) +# $Id: cust_bill.cgi,v 1.6 2001-04-22 01:38:39 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_bill.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 97-apr-4 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: cust_bill.cgi,v $ +# Revision 1.6 2001-04-22 01:38:39 ivan +# svc_domain needs to import dbh sub from Record +# view/cust_main.cgi needs to use ->owed method, not check (depriciated) owed field +# search/cust_bill.cgi redirect error when there's only one invoice +# +# Revision 1.5 2000/07/17 16:45:41 ivan +# first shot at invoice browsing and some other cleanups +# +# Revision 1.4 1999/02/28 00:03:54 ivan +# removed misleading comments +# +# Revision 1.3 1999/01/19 05:14:11 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.2 1998/12/17 09:41:07 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi $invnum $query $sortby @cust_bill ); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use Date::Format; use FS::UID qw(cgisuidsetup); -use FS::Record qw(qsearchs); +use FS::CGI qw(popurl header menubar eidiot table ); +use FS::Record qw(qsearch qsearchs); +use FS::cust_bill; +use FS::cust_main; + +$cgi = new CGI; +cgisuidsetup($cgi); + +if ( $cgi->keywords ) { + my($query) = $cgi->keywords; + if ( $query eq 'invnum' ) { + $sortby = \*invnum_sort; + @cust_bill = qsearch('cust_bill', {} ); + } elsif ( $query eq 'date' ) { + $sortby = \*date_sort; + @cust_bill = qsearch('cust_bill', {} ); + } elsif ( $query eq 'custnum' ) { + $sortby = \*custnum_sort; + @cust_bill = qsearch('cust_bill', {} ); + } elsif ( $query eq 'OPEN_invnum' ) { + $sortby = \*invnum_sort; + @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} ); + } elsif ( $query eq 'OPEN_date' ) { + $sortby = \*date_sort; + @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} ); + } elsif ( $query eq 'OPEN_custnum' ) { + $sortby = \*custnum_sort; + @cust_bill = grep $_->owed != 0, qsearch('cust_bill', {} ); + } elsif ( $query =~ /^OPEN(\d+)_invnum$/ ) { + my $open = $1 * 86400; + $sortby = \*invnum_sort; + @cust_bill = + grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} ); + } elsif ( $query =~ /^OPEN(\d+)_date$/ ) { + my $open = $1 * 86400; + $sortby = \*date_sort; + @cust_bill = + grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} ); + } elsif ( $query =~ /^OPEN(\d+)_custnum$/ ) { + my $open = $1 * 86400; + $sortby = \*custnum_sort; + @cust_bill = + grep $_->owed != 0 && $_->_date < time - $open, qsearch('cust_bill', {} ); + } else { + die "unknown query string $query"; + } +} else { + $cgi->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/; + $invnum = $2; + @cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum } ); + $sortby = \*invnum_sort; +} + +if ( scalar(@cust_bill) == 1 ) { + my $invnum = $cust_bill[0]->invnum; + print $cgi->redirect(popurl(2). "view/cust_bill.cgi?$invnum"); #redirect +} elsif ( scalar(@cust_bill) == 0 ) { + eidiot("Invoice not found."); +} else { + my $total = scalar(@cust_bill); + print $cgi->header( '-expires' => 'now' ), + &header("Invoice Search Results", menubar( + 'Main Menu', popurl(2) + )), "$total matching invoices found
                ", &table(), < + + Balance + Amount + Date + Contact name + Company + +END -my($req)=new CGI::Request; -cgisuidsetup($req->cgi); + my(%saw, $cust_bill); + foreach $cust_bill ( + sort $sortby grep(!$saw{$_->invnum}++, @cust_bill) + ) { + my($invnum, $owed, $charged, $date ) = ( + $cust_bill->invnum, + $cust_bill->owed, + $cust_bill->charged, + $cust_bill->_date, + ); + my $pdate = time2str("%b %d %Y", $date); -$req->param('invnum') =~ /^\s*(FS-)?(\d+)\s*$/; -my($invnum)=$2; + my $rowspan = 1; + + my $view = popurl(2). "view/cust_bill.cgi?$invnum"; + print < + $invnum + \$$owed + \$$charged + $pdate +END + my $custnum = $cust_bill->custnum; + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ); + if ( $cust_main ) { + my $cview = popurl(2). "view/cust_main.cgi?". $cust_main->custnum; + my ( $name, $company ) = ( + $cust_main->last. ', '. $cust_main->first, + $cust_main->company, + ); + print <$name + $company +END + } else { + print <WARNING: couldn't find cust_main.custnum $custnum (cust_bill.invnum $invnum) +END + } + + print ""; + } -if ( qsearchs('cust_bill',{'invnum'=>$invnum}) ) { - $req->cgi->redirect("../view/cust_bill.cgi?$invnum"); #redirect -} else { #error - CGI::Base::SendHeaders(); # one guess print < - - Invoice Search Error - - -
                -

                Invoice Search Error

                -
                - Invoice not found. -
                + END } +# + +sub invnum_sort { + $a->invnum <=> $b->invnum; +} + +sub custnum_sort { + $a->custnum <=> $b->custnum || $a->invnum <=> $b->invnum; +} + +sub date_sort { + $a->_date <=> $b->_date || $a->invnum <=> $b->invnum; +} diff --git a/htdocs/search/cust_main-payinfo.html b/htdocs/search/cust_main-payinfo.html index 92341ad13..47bb83cbd 100755 --- a/htdocs/search/cust_main-payinfo.html +++ b/htdocs/search/cust_main-payinfo.html @@ -2,11 +2,11 @@ Customer Search - -
                -

                Customer Search

                -
                -
                + + + Customer Search + +
                Search for Credit card #: @@ -15,7 +15,6 @@

                -
                diff --git a/htdocs/search/cust_main.cgi b/htdocs/search/cust_main.cgi index 70ce991f7..226118586 100755 --- a/htdocs/search/cust_main.cgi +++ b/htdocs/search/cust_main.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# process/cust_main.cgi: Search for customers (process form) +# $Id: cust_main.cgi,v 1.16 2001-02-07 19:45:45 ivan Exp $ # # Usage: post form to: # http://server.name/path/cust_main.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-dec-12 # # rewrite ivan@sisd.com 98-mar-4 @@ -17,64 +15,127 @@ # bmccane@maxbaud.net 98-apr-3 # # display total, use FS::CGI ivan@sisd.com 98-jul-17 +# +# $Log: cust_main.cgi,v $ +# Revision 1.16 2001-02-07 19:45:45 ivan +# tyop +# +# Revision 1.15 2000/07/17 16:45:41 ivan +# first shot at invoice browsing and some other cleanups +# +# Revision 1.14 1999/08/12 04:45:21 ivan +# typo - missed a paren +# +# Revision 1.13 1999/08/12 04:32:21 ivan +# hidecancelledcustomers +# +# Revision 1.12 1999/07/17 10:38:52 ivan +# scott nelson noticed this mod_perl-triggered bug and +# gave me a great bugreport at the last rhythmethod +# +# Revision 1.11 1999/04/09 04:22:34 ivan +# also table() +# +# Revision 1.10 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.9 1999/02/28 00:03:55 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/07 09:59:36 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/25 12:19:11 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:14:12 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:37 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 00:57:50 ivan +# bug +# +# Revision 1.3 1998/12/17 09:41:08 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/11/12 08:10:22 ivan +# CGI.pm instead of CGI-modules +# relative URLs using popurl +# got rid of lots of little tables +# s/agrep/String::Approx/; +# bubble up packages and services and link (slow) +# use strict; -use CGI::Request; +#use vars qw( $conf %ncancelled_pkgs %all_pkgs $cgi @cust_main $sortby ); +use vars qw( $conf %all_pkgs $cgi @cust_main $sortby ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use IO::Handle; -use IPC::Open2; +use String::Approx qw(amatch); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); - -my($fuzziness)=2; #fuzziness for fuzzy searches, see man agrep - #0-4: 0=no fuzz, 4=very fuzzy (too much fuzz!) - -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); - -my(@cust_main); -my($sortby); +use FS::CGI qw(header menubar eidiot popurl table); +use FS::cust_main; + +$cgi = new CGI; +cgisuidsetup($cgi); + +$conf = new FS::Conf; + +if ( $cgi->keywords ) { + my($query)=$cgi->keywords; + if ( $query eq 'custnum' ) { + $sortby=\*custnum_sort; + @cust_main=qsearch('cust_main',{}); + } elsif ( $query eq 'last' ) { + $sortby=\*last_sort; + @cust_main=qsearch('cust_main',{}); + } elsif ( $query eq 'company' ) { + $sortby=\*company_sort; + @cust_main=qsearch('cust_main',{}); + } else { + die "unknown query string $query"; + } +} else { + @cust_main=(); + &cardsearch if ( $cgi->param('card_on') && $cgi->param('card') ); + &lastsearch if ( $cgi->param('last_on') && $cgi->param('last_text') ); + &companysearch if ( $cgi->param('company_on') && $cgi->param('company_text') ); +} -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',{}); +@cust_main = grep { $_->ncancelled_pkgs || ! $_->all_pkgs } @cust_main + if $conf->exists('hidecancelledcustomers'); +if ( $conf->exists('hidecancelledpackages' ) ) { + %all_pkgs = map { $_->custnum => [ $_->ncancelled_pkgs ] } @cust_main; } else { - &cardsearch if ($req->param('card_on') ); - &lastsearch if ($req->param('last_on') ); - &companysearch if ($req->param('company_on') ); + %all_pkgs = map { $_->custnum => [ $_->all_pkgs ] } @cust_main; } if ( scalar(@cust_main) == 1 ) { - $req->cgi->redirect("../view/cust_main.cgi?". $cust_main[0]->custnum); + print $cgi->redirect(popurl(2). "view/cust_main.cgi?". $cust_main[0]->custnum); exit; } elsif ( scalar(@cust_main) == 0 ) { - idiot "No matching customers found!\n"; - exit; + eidiot "No matching customers found!\n"; } else { my($total)=scalar(@cust_main); - CGI::Base::SendHeaders(); # one guess - print header("Customer Search Results",''), < + print $cgi->header( '-expires' => 'now' ), header("Customer Search Results",menubar( + 'Main Menu', popurl(2) + )), "$total matching customers found
                ", &table(), < - Cust. # + Contact name Company + Packages + Services END - my($lines)=16; - my($lcount)=$lines; my(%saw,$cust_main); foreach $cust_main ( sort $sortby grep(!$saw{$_->custnum}++, @cust_main) @@ -85,30 +146,52 @@ END $cust_main->getfield('first'), $cust_main->company, ); + + my(@lol_cust_svc); + my($rowspan)=0;#scalar( @{$all_pkgs{$custnum}} ); + foreach ( @{$all_pkgs{$custnum}} ) { + my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } ); + push @lol_cust_svc, \@cust_svc; + $rowspan += scalar(@cust_svc) || 1; + } + + #my($rowspan) = scalar(@{$all_pkgs{$custnum}}); + my($view) = popurl(2). "view/cust_main.cgi?$custnum"; print < - $custnum - $last, $first - $company - -END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print < - - - - - + + + END + + my($n1)=''; + foreach ( @{$all_pkgs{$custnum}} ) { + my($pkgnum) = ($_->pkgnum); + my($pkg) = $_->part_pkg->pkg; + my $comment = $_->part_pkg->comment; + my($pkgview) = popurl(2). "/view/cust_pkg.cgi?$pkgnum"; + #my(@cust_svc) = shift @lol_cust_svc; + my(@cust_svc) = qsearch( 'cust_svc', { 'pkgnum' => $_->pkgnum } ); + my($rowspan) = scalar(@cust_svc) || 1; + + print $n1, qq!!; + my($n2)=''; + foreach my $cust_svc ( @cust_svc ) { + my($label, $value, $svcdb) = $cust_svc->label; + my($svcnum) = $cust_svc->svcnum; + my($sview) = popurl(2). "/view"; + print $n2,qq!!, + qq!!; + $n2=""; + } + #print qq!\n!; + $n1=""; } + print ""; } print < - END @@ -122,6 +205,8 @@ sub last_sort { } sub company_sort { + return -1 if $a->company && ! $b->company; + return 1 if ! $a->company && $b->company; $a->getfield('company') cmp $b->getfield('company'); } @@ -131,9 +216,9 @@ sub custnum_sort { sub cardsearch { - my($card)=$req->param('card'); + my($card)=$cgi->param('card'); $card =~ s/\D//g; - $card =~ /^(\d{13,16})$/ or do { idiot "Illegal card number\n"; exit; }; + $card =~ /^(\d{13,16})$/ or eidiot "Illegal card number\n"; my($payinfo)=$1; push @cust_main, qsearch('cust_main',{'payinfo'=>$payinfo, 'payby'=>'CARD'}); @@ -142,12 +227,12 @@ sub cardsearch { sub lastsearch { my(%last_type); - foreach ( $req->param('last_type') ) { + foreach ( $cgi->param('last_type') ) { $last_type{$_}++; } - $req->param('last_text') =~ /^([\w \,\.\-\']*)$/ - or do { idiot "Illegal last name"; exit; }; + $cgi->param('last_text') =~ /^([\w \,\.\-\']*)$/ + or eidiot "Illegal last name"; my($last)=$1; if ( $last_type{'Exact'} @@ -163,16 +248,9 @@ sub lastsearch { my(@all_last)=map $_->getfield('last'), qsearch('cust_main',{}); if ($last_type{'Fuzzy'}) { - my($reader,$writer) = ( new IO::Handle, new IO::Handle ); - open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k', - substr($last,0,30)); - print $writer join("\n",@all_last),"\n"; - close $writer; - while (<$reader>) { - chop; - $last{$_}++; - } - close $reader; + foreach ( amatch($last, [ qw(i) ], @all_last) ) { + $last{$_}++; + } } #if ($last_type{'Sound-alike'}) { @@ -189,12 +267,12 @@ sub lastsearch { sub companysearch { my(%company_type); - foreach ( $req->param('company_type') ) { + foreach ( $cgi->param('company_type') ) { $company_type{$_}++ }; - $req->param('company_text') =~ /^([\w \,\.\-\']*)$/ - or do { idiot "Illegal company"; exit; }; + $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/ + or eidiot "Illegal company"; my($company)=$1; if ( $company_type{'Exact'} @@ -210,16 +288,9 @@ sub companysearch { my(@all_company)=map $_->company, qsearch('cust_main',{}); if ($company_type{'Fuzzy'}) { - my($reader,$writer) = ( new IO::Handle, new IO::Handle ); - open2($reader,$writer,'agrep',"-$fuzziness",'-i','-k', - substr($company,0,30)); - print $writer join("\n",@all_company),"\n"; - close $writer; - while (<$reader>) { - chop; + foreach ( amatch($company, [ qw(i) ], @all_company ) ) { $company{$_}++; } - close $reader; } #if ($company_type{'Sound-alike'}) { diff --git a/htdocs/search/cust_main.html b/htdocs/search/cust_main.html index 656943f9c..3184698b4 100755 --- a/htdocs/search/cust_main.html +++ b/htdocs/search/cust_main.html @@ -2,22 +2,22 @@ Customer Search - -
                -

                Customer Search

                -
                -
                + + + Customer Search + +
                - Search for last name: + Search for last name: - using search method(s):
                - + END - my($lines)=16; - my($lcount)=$lines; my(%saw,$cust_pkg); foreach $cust_pkg ( sort $sortby grep(!$saw{$_->pkgnum}++, @cust_pkg) @@ -78,29 +112,25 @@ END 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, + $cust_pkg->custnum, + $cust_main ? $cust_main->last. ', '. $cust_main->first : '', + $cust_main ? $cust_main->company : '', ); + my $p = popurl(2); print < - - - - + +END + if ( $cust_main ) { + print <$custnum + + END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print < -
                Cust. #Contact nameCompany -
                $custnum$last, $first$company$pkg - $comment$label$value
                Package # Customer #NameContact name Company
                $pkgnum$custnum$name$company$pkgnum$name$company
                - - - - - - END } @@ -108,7 +138,6 @@ END print < - END diff --git a/htdocs/search/svc_acct.cgi b/htdocs/search/svc_acct.cgi index 250a741db..850865789 100755 --- a/htdocs/search/svc_acct.cgi +++ b/htdocs/search/svc_acct.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# svc_acct.cgi: Search for customers (process form) +# $Id: svc_acct.cgi,v 1.11 1999-04-14 11:25:33 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_acct.cgi @@ -21,20 +21,56 @@ # use FS::CGI, show total ivan@sisd.com 98-jul-17 # # give service and customer info too ivan@sisd.com 98-aug-16 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.11 1999-04-14 11:25:33 ivan +# *** empty log message *** +# +# Revision 1.10 1999/04/14 11:20:21 ivan +# visual fix +# +# Revision 1.9 1999/04/10 01:53:18 ivan +# oops, search usernames limited to 8 chars +# +# Revision 1.8 1999/04/09 23:43:29 ivan +# just in case +# +# Revision 1.7 1999/02/07 09:59:38 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:14:14 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:39 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1999/01/18 09:22:34 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.3 1998/12/23 03:06:28 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:41:10 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; # form processing module +use vars qw( $cgi @svc_acct $sortby $query ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); - -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +use FS::CGI qw(header eidiot popurl table); +use FS::svc_acct; +use FS::cust_main; -my(@svc_acct,$sortby); +$cgi = new CGI; +&cgisuidsetup($cgi); -my($query)=$req->cgi->var('QUERY_STRING'); +($query)=$cgi->keywords; +$query ||= ''; #to avoid use of unitialized value errors #this tree is a little bit redundant if ( $query eq 'svcnum' ) { $sortby=\*svcnum_sort; @@ -64,36 +100,35 @@ if ( $query eq 'svcnum' ) { 'pkgnum' => '', }), qsearch('svc_acct',{}); } else { + $sortby=\*uid_sort; &usernamesearch; } if ( scalar(@svc_acct) == 1 ) { my($svcnum)=$svc_acct[0]->svcnum; - $req->cgi->redirect("../view/svc_acct.cgi?$svcnum"); #redirect + print $cgi->redirect(popurl(2). "view/svc_acct.cgi?$svcnum"); #redirect exit; } elsif ( scalar(@svc_acct) == 0 ) { #error - idiot("Account not found"); - exit; + eidiot("Account not found"); } else { my($total)=scalar(@svc_acct); - CGI::Base::SendHeaders(); # one guess - print header("Account Search Results",''), < + print $cgi->header( '-expires' => 'now' ), + header("Account Search Results",''), + "$total matching accounts found", + &table(), < - - - - - - - + + + + + + + END - my($lines)=16; - my($lcount)=$lines; my(%saw,$svc_acct); + my $p = popurl(2); foreach $svc_acct ( sort $sortby grep(!$saw{$_->svcnum}++, @svc_acct) ) { @@ -119,37 +154,23 @@ END $cust_svc->pkgnum ? $cust_main->company : '', ); my($pcustnum) = $custnum - ? "$custnum" + ? "$custnum" : "(unlinked)" ; - my($pname) = $custnum ? "$last, $first" : ''; + my($pname) = $custnum ? "$last, $first" : ''; + my $pcompany = $custnum ? "$company" : ''; print < - - - + + + END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print < -
                Package #Customer #NameCompany + } else { + print <WARNING: couldn't find cust_main.custnum $custnum (cust_pkg.pkgnum $pkgnum)
                Service #UsernameUIDServiceCustomer #Contact nameCompanyService #UsernameUIDServiceCustomer #Contact nameCompany
                $svcnum$username$uid$svcnum$username$uid $svc $pcustnum $pname - $company + $pcompany
                - - - - - - - - - -END - } + } print <param('username') =~ /^([\w\d\-]{2,8})$/; #untaint username_text + $cgi->param('username') =~ /^([\w\d\-]+)$/; #untaint username_text my($username)=$1; @svc_acct=qsearch('svc_acct',{'username'=>$username}); diff --git a/htdocs/search/svc_acct_sm.cgi b/htdocs/search/svc_acct_sm.cgi index 3b1a4cf4e..ddf2a1f23 100755 --- a/htdocs/search/svc_acct_sm.cgi +++ b/htdocs/search/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_acct_sm.cgi: Search for domains (process form) +# $Id: svc_acct_sm.cgi,v 1.10 1999-07-20 06:03:36 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-mar-5 # # need to look at table in results to make it more readable @@ -17,33 +15,61 @@ # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.10 1999-07-20 06:03:36 ivan +# s/CGI::Request/CGI/; (how'd i miss that before?) +# +# Revision 1.9 1999/04/09 04:22:34 ivan +# also table() +# +# Revision 1.8 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.7 1999/02/28 00:03:56 ivan +# removed misleading comments +# +# Revision 1.6 1999/02/09 09:22:58 ivan +# visual and bugfixes +# +# Revision 1.5 1999/01/19 05:14:16 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.4 1999/01/18 09:41:40 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.3 1998/12/17 09:41:11 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw( $conf $cgi $mydomain $domuser $svc_domain $domsvc @svc_acct_sm ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl idiot header table); use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::svc_domain; +use FS::svc_acct_sm; +use FS::svc_acct; -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 $_ !~ /^(#|$)/, ; -close DOMAIN; +$cgi = new CGI; +&cgisuidsetup($cgi); -my($req)=new CGI::Request; # create form object -&cgisuidsetup($req->cgi); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); -$req->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/; -my($domuser)=$1; +$cgi->param('domuser') =~ /^([a-z0-9_\-]{0,32})$/; +$domuser = $1; -$req->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain"; -my($svc_domain)=qsearchs('svc_domain',{'domain'=>$1}) +$cgi->param('domain') =~ /^([\w\-\.]+)$/ or die "Illegal domain"; +$svc_domain = qsearchs('svc_domain',{'domain'=>$1}) or die "Unknown domain"; -my($domsvc)=$svc_domain->svcnum; +$domsvc = $svc_domain->svcnum; -my(@svc_acct_sm); if ($domuser) { @svc_acct_sm=qsearch('svc_acct_sm',{ 'domuser' => $domuser, @@ -55,21 +81,14 @@ if ($domuser) { if ( scalar(@svc_acct_sm) == 1 ) { my($svcnum)=$svc_acct_sm[0]->svcnum; - $req->cgi->redirect("../view/svc_acct_sm.cgi?$svcnum"); #redirect + print $cgi->redirect(popurl(2). "view/svc_acct_sm.cgi?$svcnum"); } elsif ( scalar(@svc_acct_sm) > 1 ) { - CGI::Base::SendHeaders(); - print < - - Mail Alias Search Results - - -
                -

                Mail Alias Search Results

                -
                Service #UserameUIDServiceCustomer #Contact nameCompany
                + print $cgi->header( '-expires' => 'now' ), + header('Mail Alias Search Results'), + &table(), < - - + + END @@ -81,48 +100,41 @@ END $svc_acct_sm->domuid, $svc_acct_sm->domsvc, ); - my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$domsvc}); - my($domain)=$svc_domain->domain; - my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid}); - my($username)=$svc_acct->username; - my($svc_acct_svcnum)=$svc_acct->svcnum; - - print <\n \n -\n \n -END + my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } ); + if ( $svc_domain ) { + my $domain = $svc_domain->domain; + + print qq!!, + ; + } else { + my $warning = "couldn't find svc_domain.svcnum $svcnum ( svc_acct_sm.svcnum $svcnum"; + warn $warning; + print ""; + } + + my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $domuid } ); + if ( $svc_acct ) { + my $username = $svc_acct->username; + my $svc_acct_svcnum =$svc_acct->svcnum; + print qq!! + ; + } else { + my $warning = "couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum $svcnum)!"; + warn $warning; + print ""; + } } - print < - - - -END + print '
                Mail to
                (click here to view mail alias)
                Forwards to
                (click here to view account)
                Mail to
                (click to view mail alias)
                Forwards to
                (click to view account)
                -END - - print '', ( ($domuser eq '*') ? "(anything)" : $domuser ); - print < $username\@$mydomain
                !, + #print '', ( ($domuser eq '*') ? "(anything)" : $domuser ); + ( ($domuser eq '*') ? "(anything)" : $domuser ), + qq!\@$domain
                WARNING: $warning$username\@$mydomain!, + qq!
                WARNING: $warning
                '; } else { #error - CGI::Base::SendHeaders(); # one guess - print < - - Mail Alias Search Error - - -
                -

                Mail Alias Search Error

                -
                - Mail Alias not found. -
                - - -END - + idiot("Mail Alias not found"); } diff --git a/htdocs/search/svc_domain.cgi b/htdocs/search/svc_domain.cgi index d5277037b..f1d4ae461 100755 --- a/htdocs/search/svc_domain.cgi +++ b/htdocs/search/svc_domain.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# svc_domain.cgi: Search for domains (process form) +# $Id: svc_domain.cgi,v 1.11 2000-03-03 18:22:44 ivan Exp $ # # Usage: post form to: # http://server.name/path/svc_domain.cgi # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 97-mar-5 # # rewrite ivan@sisd.com 98-mar-14 @@ -15,21 +13,61 @@ # bmccane@maxbaud.net 98-apr-3 # # display total, use FS::CGI now does browsing too ivan@sisd.com 98-jul-17 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.11 2000-03-03 18:22:44 ivan +# changes from 1.2.3 release, fixes from webdemo +# +# Revision 1.10 1999/07/17 10:38:52 ivan +# scott nelson noticed this mod_perl-triggered bug and +# gave me a great bugreport at the last rhythmethod +# +# Revision 1.9 1999/04/15 13:39:16 ivan +# $cgi->header( '-expires' => 'now' ) +# +# Revision 1.8 1999/02/28 00:03:57 ivan +# removed misleading comments +# +# Revision 1.7 1999/02/23 08:09:24 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.6 1999/02/09 09:22:59 ivan +# visual and bugfixes +# +# Revision 1.5 1999/02/07 09:59:39 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.4 1999/01/19 05:14:17 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.3 1998/12/23 03:06:50 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:41:12 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; -use CGI::Request; +use vars qw ( $cgi @svc_domain $sortby $query $conf $mydomain ); +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); use FS::Record qw(qsearch qsearchs); -use FS::CGI qw(header idiot); +use FS::CGI qw(header eidiot popurl); +use FS::svc_domain; +use FS::cust_svc; +use FS::svc_acct_sm; +use FS::svc_acct; -my($req)=new CGI::Request; -&cgisuidsetup($req->cgi); +$cgi = new CGI; +&cgisuidsetup($cgi); -my(@svc_domain); -my($sortby); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); -my($query)=$req->cgi->var('QUERY_STRING'); +($query)=$cgi->keywords; +$query ||= ''; #to avoid use of unitialized value errors if ( $query eq 'svcnum' ) { $sortby=\*svcnum_sort; @svc_domain=qsearch('svc_domain',{}); @@ -49,36 +87,35 @@ if ( $query eq 'svcnum' ) { 'pkgnum' => '', }), qsearch('svc_domain',{}); } else { - $req->param('domain') =~ /^([\w\-\.]+)$/; + $cgi->param('domain') =~ /^([\w\-\.]+)$/; my($domain)=$1; - push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain}); + #push @svc_domain, qsearchs('svc_domain',{'domain'=>$domain}); + @svc_domain = qsearchs('svc_domain',{'domain'=>$domain}); } if ( scalar(@svc_domain) == 1 ) { - $req->cgi->redirect("../view/svc_domain.cgi?". $svc_domain[0]->svcnum); + print $cgi->redirect(popurl(2). "view/svc_domain.cgi?". $svc_domain[0]->svcnum); exit; } elsif ( scalar(@svc_domain) == 0 ) { - idiot "No matching domains found!\n"; - exit; + eidiot "No matching domains found!\n"; } else { - CGI::Base::SendHeaders(); # one guess my($total)=scalar(@svc_domain); - CGI::Base::SendHeaders(); # one guess - print header("Domain Search Results",''), <header( '-expires' => 'now' ), + header("Domain Search Results",''), < Service # Domain - + Mail to
                (click to view mail alias) + Forwards to
                (click to view account) END - my($lines)=16; - my($lcount)=$lines; my(%saw,$svc_domain); + my $p = popurl(2); foreach $svc_domain ( sort $sortby grep(!$saw{$_->svcnum}++, @svc_domain) ) { @@ -86,42 +123,76 @@ END $svc_domain->svcnum, $svc_domain->domain, ); - my($malias); - if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) { - $malias=( - qq||. - qq||. - qq||. - qq||. - qq|| - ); - } else { - $malias=''; - } + #my($malias); + #if ( qsearch('svc_acct_sm',{'domsvc'=>$svcnum}) ) { + # $malias=( + # qq|
                |. + # qq||. + # qq||. + # qq||. + # qq|
                | + # ); + #} else { + # $malias=''; + #} + + my @svc_acct_sm=qsearch('svc_acct_sm',{'domsvc' => $svcnum}); + my $rowspan = scalar(@svc_acct_sm) || 1; + print < - $svcnum - $domain - $malias - -END - if ($lcount-- == 0) { # lots of little tables instead of one big one - $lcount=$lines; - print < - - - - - - + + END + + my $n1 = ''; + # false laziness: this was stolen from search/svc_acct_sm.cgi. but the + # web interface in general needs to be rewritten in a mucho cleaner way + my($svc_acct_sm); + foreach $svc_acct_sm (@svc_acct_sm) { + my($svcnum,$domuser,$domuid,$domsvc)=( + $svc_acct_sm->svcnum, + $svc_acct_sm->domuser, + $svc_acct_sm->domuid, + $svc_acct_sm->domsvc, + ); + #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $domsvc } ); + #if ( $svc_domain ) { + # my $domain = $svc_domain->domain; + + print qq!$n1!, + ; + #} else { + # my $warning = "couldn't find svc_domain.svcnum $svcnum ( svc_acct_sm.svcnum $svcnum"; + # warn $warning; + # print "$n1"; + #} + + my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $domuid } ); + if ( $svc_acct ) { + my $username = $svc_acct->username; + my $svc_acct_svcnum =$svc_acct->svcnum; + print qq!! + ; + } else { + my $warning = "couldn't find svc_acct.uid $domuid (svc_acct_sm.svcnum $svcnum)!"; + warn $warning; + print ""; + } + $n1 = ""; } + #end of false laziness + print ""; + } print < - END diff --git a/htdocs/view/cust_bill.cgi b/htdocs/view/cust_bill.cgi index 96101d004..93a6f7a29 100755 --- a/htdocs/view/cust_bill.cgi +++ b/htdocs/view/cust_bill.cgi @@ -1,9 +1,6 @@ #!/usr/bin/perl -Tw # -# Usage: cust_bill.cgi invnum -# http://server.name/path/cust_bill.cgi?invnum -# -# Note: Should be run setuid freeside as user nobody. +# $Id: cust_bill.cgi,v 1.8 1999-02-28 00:03:58 ivan Exp $ # # this is a quick & ugly hack which does little more than add some formatting to the ascii output from /dbin/print-invoice # @@ -24,50 +21,67 @@ # bmccane@maxbaud.net 98-apr-3 # # also print 'printed' field ivan@sisd.com 98-jul-10 +# +# $Log: cust_bill.cgi,v $ +# Revision 1.8 1999-02-28 00:03:58 ivan +# removed misleading comments +# +# Revision 1.7 1999/01/25 12:26:03 ivan +# yet more mod_perl stuff +# +# Revision 1.6 1999/01/19 05:14:18 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:42 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/30 23:03:33 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.3 1998/12/23 03:07:49 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.2 1998/12/17 09:57:20 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# use strict; +use vars qw ( $cgi $query $invnum $cust_bill $custnum $printed $p ); use IO::File; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl menubar); use FS::Record qw(qsearchs); -use FS::Invoice; +use FS::cust_bill; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; &cgisuidsetup($cgi); #untaint invnum -$QUERY_STRING =~ /^(\d+)$/; -my($invnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$invnum = $1; -my($cust_bill) = qsearchs('cust_bill',{'invnum'=>$invnum}); +$cust_bill = qsearchs('cust_bill',{'invnum'=>$invnum}); die "Invoice #$invnum not found!" unless $cust_bill; -my($custnum) = $cust_bill->getfield('custnum'); +$custnum = $cust_bill->getfield('custnum'); -my($printed) = $cust_bill->printed; +$printed = $cust_bill->printed; -SendHeaders(); # one guess. -print < - - Invoice View - - -
                -

                Invoice View

                - View this customer (#$custnum) | Main menu -

                - -
                - Enter payments (check/cash) against this invoice -
                Reprint this invoice +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Invoice View', menubar( + "Main Menu" => $p, + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", +)), <Enter payments (check/cash) against this invoice +
                Reprint this invoice

                (Printed $printed times) -
                -
                +    
                 END
                 
                -bless($cust_bill,"FS::Invoice");
                 print $cust_bill->print_text;
                 
                 	#formatting
                diff --git a/htdocs/view/cust_main.cgi b/htdocs/view/cust_main.cgi
                index ca5fcd94f..ff169fdae 100755
                --- a/htdocs/view/cust_main.cgi
                +++ b/htdocs/view/cust_main.cgi
                @@ -1,12 +1,10 @@
                 #!/usr/bin/perl -Tw
                 #
                -# cust_main.cgi: View a customer
                +# $Id: cust_main.cgi,v 1.19 2001-04-22 01:38:39 ivan Exp $
                 #
                 # Usage: cust_main.cgi custnum
                 #        http://server.name/path/cust_main.cgi?custnum
                 #
                -# Note: Should be run setuid freeside as user nobody.
                -#
                 # the payment history section could use some work, see below
                 # 
                 # ivan@voicenet.com 96-nov-29 -> 96-dec-11
                @@ -31,147 +29,234 @@
                 #       bmccane@maxbaud.net     98-apr-3
                 #
                 # lose background, FS::CGI ivan@sisd.com 98-sep-2
                +#
                +# $Log: cust_main.cgi,v $
                +# Revision 1.19  2001-04-22 01:38:39  ivan
                +# svc_domain needs to import dbh sub from Record
                +# view/cust_main.cgi needs to use ->owed method, not check (depriciated) owed field
                +# search/cust_bill.cgi redirect error when there's only one invoice
                +#
                +# Revision 1.18  1999/08/12 04:16:01  ivan
                +# hidecancelledpackages config option
                +#
                +# Revision 1.17  1999/04/15 16:44:36  ivan
                +# delete customers
                +#
                +# Revision 1.16  1999/04/09 04:22:34  ivan
                +# also table()
                +#
                +# Revision 1.15  1999/04/09 03:52:55  ivan
                +# explicit & for table/itable/ntable
                +#
                +# Revision 1.14  1999/04/08 04:04:37  ivan
                +# eliminate double // in links
                +#
                +# Revision 1.13  1999/02/28 00:04:00  ivan
                +# removed misleading comments
                +#
                +# Revision 1.12  1999/02/07 09:59:40  ivan
                +# more mod_perl fixes, and bugfixes Peter Wemm sent via email
                +#
                +# Revision 1.11  1999/01/25 12:26:04  ivan
                +# yet more mod_perl stuff
                +#
                +# Revision 1.10  1999/01/19 05:14:19  ivan
                +# for mod_perl: no more top-level my() variables; use vars instead
                +# also the last s/create/new/;
                +#
                +# Revision 1.9  1999/01/18 09:41:43  ivan
                +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl
                +# (good idea anyway)
                +#
                +# Revision 1.8  1999/01/18 09:22:35  ivan
                +# changes to track email addresses for email invoicing
                +#
                +# Revision 1.7  1998/12/30 23:03:34  ivan
                +# bugfixes; fields isn't exported by derived classes
                +#
                +# Revision 1.6  1998/12/23 02:42:33  ivan
                +# remove double '/' in link urls
                +#
                +# Revision 1.5  1998/12/23 02:36:28  ivan
                +# use FS::cust_refund; to eliminate warning
                +#
                +# Revision 1.4  1998/12/17 09:57:21  ivan
                +# s/CGI::(Base|Request)/CGI.pm/;
                +#
                +# Revision 1.3  1998/11/15 13:14:20  ivan
                +# first pass as per-customer custom pricing
                +#
                +# Revision 1.2  1998/11/13 11:28:08  ivan
                +# s/CGI-modules/CGI.pm/;, relative URL's with popurl
                +#
                 
                 use strict;
                -use CGI::Base qw(:DEFAULT :CGI); # CGI module
                +use vars qw ( $cgi $query $custnum $cust_main $hashref $agent $referral 
                +              @packages $package @history @bills $bill @credits $credit
                +              $balance $item @agents @referrals @invoicing_list $n1 $conf ); 
                +use CGI;
                 use CGI::Carp qw(fatalsToBrowser);
                 use Date::Format;
                 use FS::UID qw(cgisuidsetup);
                 use FS::Record qw(qsearchs qsearch);
                -use FS::CGI qw(header menubar);
                -
                -my($cgi) = new CGI::Base;
                -$cgi->get;
                +use FS::CGI qw(header menubar popurl table itable ntable);
                +use FS::cust_credit;
                +use FS::cust_pay;
                +use FS::cust_bill;
                +use FS::part_pkg;
                +use FS::cust_pkg;
                +use FS::part_referral;
                +use FS::agent;
                +use FS::cust_main;
                +use FS::cust_refund;
                +
                +$cgi = new CGI;
                 &cgisuidsetup($cgi);
                 
                -SendHeaders(); # one guess.
                -print header("Customer View", menubar(
                -  'Main Menu' => '../',
                -)),<
                -END
                -
                -#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 "
                Customer #$custnum
                ", - qq!
                Customer Information | !, - qq!Comments | !, - qq!Packages | !, - qq!Payment History
                !; +$conf = new FS::Conf; -#bill now linke -print qq!
                !, - qq!Bill this customer now
                !; +print $cgi->header( '-expires' => 'now' ), header("Customer View", menubar( + 'Main Menu' => popurl(2) +)); -#formatting -print qq!
                Customer Information!, - qq!!, - qq!
                Edit this information
                !; - -#agentnum -my($agent)=qsearchs('agent',{ - 'agentnum' => $cust_main->getfield('agentnum') -} ); -die "Agent not found!" unless $agent; -print "
                Agent #" , $agent->getfield('agentnum') , ": " , - $agent->getfield('agent') , ""; - -#refnum -my($referral)=qsearchs('part_referral',{'refnum' => $cust_main->refnum}); -die "Referral not found!" unless $referral; -print "
                Referral #", $referral->refnum, ": ", - $referral->referral, "<\B>"; - -#last, first -print "

                ", $hashref->{'last'}, ", ", $hashref->{first}, ""; - -#ss -print " (SS# ", $hashref->{ss}, ")" if $hashref->{ss}; - -#company -print "
                ", $hashref->{company}, "" if $hashref->{company}; - -#address1 -print "
                ", $hashref->{address1}, ""; - -#address2 -print "
                ", $hashref->{address2}, "" if $hashref->{address2}; - -#city -print "
                ", $hashref->{city}, ""; - -#county -print " (", $hashref->{county}, " county)" if $hashref->{county}; - -#state -print ",", $hashref->{state}, ""; - -#zip -print " ", $hashref->{zip}, ""; - -#country -print "
                ", $hashref->{country}, "" - unless $hashref->{country} eq "US"; - -#daytime -print "

                ", $hashref->{daytime}, "" if $hashref->{daytime}; -print " (Day)" if $hashref->{daytime} && $hashref->{night}; - -#night -print "
                ", $hashref->{night}, "" if $hashref->{night}; -print " (Night)" if $hashref->{daytime} && $hashref->{night}; - -#fax -print "
                ", $hashref->{fax}, " (Fax)" if $hashref->{fax}; - -#payby/payinfo/paydate/payname -if ($hashref->{payby} eq "CARD") { - print "

                Card #", $hashref->{payinfo}, " Exp. ", - $hashref->{paydate}, ""; - print " (", $hashref->{payname}, ")" if $hashref->{payname}; -} elsif ($hashref->{payby} eq "BILL") { - print "

                Bill"; - print " on P.O. #", $hashref->{payinfo}, "" - if $hashref->{payinfo}; - print " until ", $hashref->{paydate}, "" - if $hashref->{paydate}; - print " to ", $hashref->{payname}, " at above address" - if $hashref->{payname}; -} elsif ($hashref->{payby} eq "COMP") { - print "

                Access complimentary"; - print " courtesy of ", $hashref->{payinfo}, "" - if $hashref->{payinfo}; - print " until ", $hashref->{paydate}, "" - if $hashref->{paydate}; -} else { - print "Unknown payment type ", $hashref->{payby}, "!"; +die "No customer specified (bad URL)!" unless $cgi->keywords; +($query) = $cgi->keywords; # needs parens with my, ->keywords returns array +$query =~ /^(\d+)$/; +$custnum = $1; +$cust_main = qsearchs('cust_main',{'custnum'=>$custnum}); +die "Customer not found!" unless $cust_main; +$hashref = $cust_main->hashref; + +print &itable(), '

                ', +; + +@agents = qsearch( 'agent', {} ); +unless ( scalar(@agents) == 1 ) { + $agent = qsearchs('agent',{ + 'agentnum' => $cust_main->agentnum + } ); + print ''; +} +@referrals = qsearch( 'part_referral', {} ); +unless ( scalar(@referrals) == 1 ) { + my $referral = qsearchs('part_referral', { + 'refnum' => $cust_main->refnum + } ); + print ''; +} +print ''; + +print '
                Service #Domain
                $svcnum$domain!, + #print '', ( ($domuser eq '*') ? "(anything)" : $domuser ); + ( ($domuser eq '*') ? "(anything)" : $domuser ), + qq!\@$domain WARNING: $warning$username\@$mydomain!, + qq!
                WARNING: $warning
                '; + +print qq!Edit this customer!; +print qq! | Delete this customer! + if $conf->exists('deletecustomers'); +print &ntable("#c0c0c0"), "
                ", &ntable("#c0c0c0",2), + '
                Customer number', + $custnum, '
                Agent', + $agent->agentnum, ": ", $agent->agent, '
                Referral', + $referral->refnum, ": ", $referral->referral, '
                Order taker', + $cust_main->otaker, '
                '; + +print ''; + +print "Contact information", &ntable("#c0c0c0"), "", + &ntable("#c0c0c0",2), + 'Contact name
                (last, first)', + '', + $cust_main->last, ', ', $cust_main->first, + 'SS#', + $cust_main->ss || ' ', '', + 'Company', + $cust_main->company, + '', + 'Address', + $cust_main->address1, + '', +; +print ' ', + $cust_main->address2, '' + if $cust_main->address2; +print 'City', + $cust_main->city, + 'State', + $cust_main->state, + 'Zip', + $cust_main->zip, '', + 'Country', + $cust_main->country, + '', +; +print 'Day Phone', + $cust_main->daytime || ' ', '', + 'Night Phone', + $cust_main->night || ' ', '', + 'Fax', + $cust_main->fax || ' ', '', + '', "" +; + +print ''; + +@invoicing_list = $cust_main->invoicing_list; +print "Billing information (", + qq!!, "Bill now)", + &ntable("#c0c0c0"), "", &ntable("#c0c0c0",2), + 'Tax exempt', + $cust_main->tax ? 'yes' : 'no', + '', + 'Postal invoices', + ( grep { $_ eq 'POST' } @invoicing_list ) ? 'yes' : 'no', + '', + 'Email invoices', + join(', ', grep { $_ ne 'POST' } @invoicing_list ) || 'no', + '', + 'Billing type', +; + +if ( $cust_main->payby eq 'CARD' ) { + print 'Credit card', + 'Card number', + $cust_main->payinfo, '', + 'Expiration', + $cust_main->paydate, '', + 'Name on card', + $cust_main->payname, '' + ; +} elsif ( $cust_main->payby eq 'BILL' ) { + print 'Billing'; + print 'P.O. ', + $cust_main->payinfo, '', + if $cust_main->payinfo; + print 'Expiration', + $cust_main->paydate, '', + 'Attention', + $cust_main->payname, '', + ; +} elsif ( $cust_main->payby eq 'COMP' ) { + print 'Complimentary', + 'Authorized by', + $cust_main->payinfo, '', + 'Expiration', + $cust_main->paydate, '', + ; } -#tax -print "
                (Tax exempt)" if $hashref->{tax}; - -#otaker -print "

                Order taken by ", $hashref->{otaker}, ""; +print ""; -#formatting -print qq!


                Packages!, - qq!
                Click on package number to view/edit package.!, - qq!
                Add/Edit packages!, - qq!

                !; +print qq!

                Packages !, +# qq!
                Click on package number to view/edit package.!, + qq!( Order and cancel packages )!, +; #display packages #formatting -print qq!
                \n!, - qq!\n!, +print qq!!, &table(), "\n", + qq!\n!, qq!
                #Package!, - qq!Dates
                Package!, + qq!DatesServices
                Setup!, qq!Next bill!, qq!Susp.Expire!, @@ -180,67 +265,83 @@ print qq!
                \n!, qq!\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!!, - "", - "", - "", - "", - "", - "", - ""; +if ( $conf->exists('hidecancelledpackages') ) { + @packages = $cust_main->ncancelled_pkgs; +} else { + @packages = $cust_main->all_pkgs; } +$n1 = ''; +foreach $package (@packages) { + my $pkgnum = $package->pkgnum; + my $pkg = $package->part_pkg->pkg; + my $comment = $package->part_pkg->comment; + my $pkgview = popurl(2). "view/cust_pkg.cgi?$pkgnum"; + my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ); + my $rowspan = scalar(@cust_svc) || 1; + + my $button_cgi = new CGI; + $button_cgi->param('clone', $package->part_pkg->pkgpart); + $button_cgi->param('pkgnum', $package->pkgnum); + my $button_url = popurl(2). "edit/part_pkg.cgi?". $button_cgi->query_string; + + #print $n1, qq!!, + print $n1, qq!!, + qq!!, + ; + for ( qw( setup bill susp expire cancel ) ) { + print "', + ; + } + + my $n2 = ''; + foreach my $cust_svc ( @cust_svc ) { + my($label, $value, $svcdb) = $cust_svc->label; + my($svcnum) = $cust_svc->svcnum; + my($sview) = popurl(2). "view"; + print $n2,qq!!, + qq!!; + $n2=""; + } + $n1=""; +} +print ""; + #formatting -print "
                !, - $pref->{pkgnum}, qq!", $part_pkg->getfield('pkg'), " - ", - $part_pkg->getfield('comment'), "", - $pref->{setup} ? time2str("%D",$pref->{setup} ) : "" , - "", - $pref->{bill} ? time2str("%D",$pref->{bill} ) : "" , - "", - $pref->{susp} ? time2str("%D",$pref->{susp} ) : "" , - "", - $pref->{expire} ? time2str("%D",$pref->{expire} ) : "" , - "", - $pref->{cancel} ? time2str("%D",$pref->{cancel} ) : "" , - "
                $pkgnum$pkgnum!, + #qq!$pkg - $comment!, + qq!$pkg - $comment!, + qq! ( Edit | Customize pricing )", ( $package->getfield($_) + ? time2str("%D", $package->getfield($_) ) + : ' ' + ), '$label$value
                "; +print "
                "; #formatting -print qq!

                Payment History!, - qq!
                !, - qq!Click on invoice to view invoice/enter payment.
                !, - qq!!, - qq!Post Credit / Refund

                !; +print qq!

                Payment History!, + qq!!, + qq! ( Click on invoice to view invoice/enter payment. | !, + qq!!, + qq!Post credit / refund )!; #get payment history # # major problem: this whole thing is way too sloppy. # minor problem: the description lines need better formatting. -my(@history); +@history = (); #needed for mod_perl :) -my(@bills)=qsearch('cust_bill',{'custnum'=>$custnum}); -my($bill); +@bills = qsearch('cust_bill',{'custnum'=>$custnum}); foreach $bill (@bills) { my($bref)=$bill->hashref; push @history, - $bref->{_date} . qq!\t{invnum} . qq!">Invoice #! . $bref->{invnum} . - qq! (Balance \$! . $bref->{owed} . qq!)\t! . + qq! (Balance \$! . $bill->owed . qq!)\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'), @@ -252,8 +353,7 @@ foreach $bill (@bills) { } } -my(@credits)=qsearch('cust_credit',{'custnum'=>$custnum}); -my($credit); +@credits = qsearch('cust_credit',{'custnum'=>$custnum}); foreach $credit (@credits) { my($cref)=$credit->hashref; push @history, @@ -274,8 +374,7 @@ foreach $credit (@credits) { } #formatting - print < + print &table(), < @@ -289,8 +388,7 @@ END #display payment history -my($balance)=0; -my($item); +$balance = 0; foreach $item (sort keyfield_numerically @history) { my($date,$desc,$charge,$payment,$credit,$refund)=split(/\t/,$item); $charge ||= 0; @@ -320,7 +418,7 @@ foreach $item (sort keyfield_numerically @history) { } #formatting -print "
                Date Description
                "; +print ""; #end diff --git a/htdocs/view/cust_pkg.cgi b/htdocs/view/cust_pkg.cgi index 04e38326a..0054ee0fa 100755 --- a/htdocs/view/cust_pkg.cgi +++ b/htdocs/view/cust_pkg.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# cust_pkg.cgi: View a package +# $Id: cust_pkg.cgi,v 1.11 1999-04-09 04:22:34 ivan Exp $ # # Usage: cust_pkg.cgi pkgnum # http://server.name/path/cust_pkg.cgi?pkgnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-dec-15 # # services section needs to be cleaned up, needs to display extraneous @@ -24,118 +22,140 @@ # ivan@voicenet.com 97-jul-29 # # no FS::Search ivan@sisd.com 98-mar-7 +# +# $Log: cust_pkg.cgi,v $ +# Revision 1.11 1999-04-09 04:22:34 ivan +# also table() +# +# Revision 1.10 1999/04/09 03:52:55 ivan +# explicit & for table/itable/ntable +# +# Revision 1.9 1999/04/08 12:00:19 ivan +# aesthetic update +# +# Revision 1.8 1999/02/28 00:04:01 ivan +# removed misleading comments +# +# Revision 1.7 1999/01/19 05:14:20 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:44 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1998/12/23 03:11:40 ivan +# *** empty log message *** +# +# Revision 1.3 1998/12/17 09:57:22 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/11/13 09:56:49 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; +use vars qw ( $cgi %uiview %uiadd $part_svc $query $pkgnum $cust_pkg $part_pkg + $custnum $susp $cancel $expire $pkg $comment $setup $bill + $otaker ); use Date::Format; -use CGI::Base qw(:DEFAULT :CGI); # CGI module +use CGI; +use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); +use FS::CGI qw(popurl header menubar ntable table); use FS::Record qw(qsearch qsearchs); +use FS::part_svc; +use FS::cust_pkg; +use FS::part_pkg; +use FS::pkg_svc; +use FS::cust_svc; -my($cgi) = new CGI::Base; -$cgi->get; -&cgisuidsetup($cgi); +$cgi = new CGI; +cgisuidsetup($cgi); -my(%uiview,%uiadd); -my($part_svc); foreach $part_svc ( qsearch('part_svc',{}) ) { - $uiview{$part_svc->svcpart}="../view/". $part_svc->svcdb . ".cgi"; - $uiadd{$part_svc->svcpart}="../edit/". $part_svc->svcdb . ".cgi"; + $uiview{$part_svc->svcpart} = popurl(2). "view/". $part_svc->svcdb . ".cgi"; + $uiadd{$part_svc->svcpart}= popurl(2). "edit/". $part_svc->svcdb . ".cgi"; } -SendHeaders(); # one guess. -print < - - Package View - - -
                -

                Package View

                -
                - -END - -#untaint pkgnum -$QUERY_STRING =~ /^(\d+)$/; -my($pkgnum)=$1; +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$pkgnum = $1; #get package record -my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); +$cust_pkg = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); die "No package!" unless $cust_pkg; -my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')}); +$part_pkg = qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->getfield('pkgpart')}); -#nav bar -my($custnum)=$cust_pkg->getfield('custnum'); -print qq!
                View this customer!, - qq! (#$custnum) | Main menu

                !; +$custnum = $cust_pkg->getfield('custnum'); +print $cgi->header( '-expires' => 'now' ), header('Package View', menubar( + "View this customer (#$custnum)" => popurl(2). "view/cust_main.cgi?$custnum", + 'Main Menu' => popurl(2) +)); #print info -my($susp,$cancel,$expire)=( +($susp,$cancel,$expire)=( $cust_pkg->getfield('susp'), $cust_pkg->getfield('cancel'), $cust_pkg->getfield('expire'), ); -print "
                Package #$pkgnum"; -print qq!
                Package Information!; -print qq! | Service Information! unless $cancel; -print qq!

                \n!; - -my($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment')); -print qq!
                Package Information!, - qq!!; -print qq!
                Edit this information
                !; -print "

                Package: $pkg - $comment"; - -my($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill')); -print "
                Setup: ", $setup ? time2str("%D",$setup) : "(Not setup)" ,""; -print "
                Next bill: ", $bill ? time2str("%D",$bill) : "" ,""; - -if ($susp) { - print "
                Suspended: ", time2str("%D",$susp), ""; - print qq! Unsuspend! unless $cancel; -} else { - print qq!
                Suspend! unless $cancel; -} - -if ($expire) { - print "
                Expire: ", time2str("%D",$expire), ""; -} - print < - -Expire (date): - -END - -if ($cancel) { - print "
                Cancelled: ", time2str("%D",$cancel), ""; -} else { - print qq!
                Cancel now!; -} - -#otaker -my($otaker)=$cust_pkg->getfield('otaker'); -print "

                Order taken by $otaker"; +($pkg,$comment)=($part_pkg->getfield('pkg'),$part_pkg->getfield('comment')); +($setup,$bill)=($cust_pkg->getfield('setup'),$cust_pkg->getfield('bill')); +$otaker = $cust_pkg->getfield('otaker'); + +print "Package information"; +print ' (unsuspend)' if ( $susp && ! $cancel ); +print ' (suspend)' unless ( $susp || $cancel ); +print ' (cancel)' unless $cancel; + +print &ntable("#c0c0c0"), '', &ntable("#c0c0c0",2), + 'Package number', + $pkgnum, '', + 'Package', + $pkg, '', + 'Comment', + $comment, '', + 'Setup date', + ( $setup ? time2str("%D",$setup) : "(Not setup)" ), '', + 'Next bill date', + ( $bill ? time2str("%D",$bill) : " " ), '', +; +print 'Suspension date', + time2str("%D",$susp), '' if $susp; +print 'Expiration date', + time2str("%D",$expire), '' if $expire; +print 'Cancellation date', + time2str("%D",$cancel), '' if $cancel; +print 'Order taker', + $otaker, '', + '' +; + +# print < +# +#Expire (date): +# +#END unless ($cancel) { #services - print <

                Service Information -
                Click on service to view/edit/add service.

                -
                Do NOT pick the "Link to existing" option unless you are auditing!!!
                -
                - -END + print '
                Service Information', &table(); #list of services this pkgpart includes - my($pkg_svc,%pkg_svc); + my $pkg_svc; + my %pkg_svc = (); foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $cust_pkg->pkgpart }) ) { $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity; } #list of records from cust_svc - my($svcpart); + my $svcpart; foreach $svcpart (sort {$a <=> $b} keys %pkg_svc) { my($svc)=qsearchs('part_svc',{'svcpart'=>$svcpart})->getfield('svc'); @@ -150,8 +170,9 @@ END my($cust_svc); if ( $cust_svc=shift @cust_svc ) { my($svcnum)=$cust_svc->svcnum; + my($label, $value, $svcdb) = $cust_svc->label; print < + END } else { print <"; - + print "
                Service(View) $svc
                (View) $svc: $value
                ", + "Choose (View) to view or edit an existing service
                ", + "Choose (Add) to setup a new service
                ", + "Choose (Link to existing) to link to a legacy (pre-Freeside) service", + "
                " + ; } #formatting diff --git a/htdocs/view/svc_acct.cgi b/htdocs/view/svc_acct.cgi index 7096c2fb1..40e3c2d15 100755 --- a/htdocs/view/svc_acct.cgi +++ b/htdocs/view/svc_acct.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# View svc_acct records +# $Id: svc_acct.cgi,v 1.12 2001-01-31 07:21:00 ivan Exp $ # # Usage: svc_acct.cgi svcnum # http://server.name/path/svc_acct.cgi?svcnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 96-dec-17 # # added link to send info @@ -33,122 +31,136 @@ # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17 # # displays arbitrary radius attributes ivan@sisd.com 98-aug-16 +# +# $Log: svc_acct.cgi,v $ +# Revision 1.12 2001-01-31 07:21:00 ivan +# fix tyops +# +# Revision 1.11 2000/12/03 20:25:20 ivan +# session monitor updates +# +# Revision 1.10 1999/04/14 11:27:06 ivan +# showpasswords config option to show passwords +# +# Revision 1.9 1999/04/08 12:00:19 ivan +# aesthetic update +# +# Revision 1.8 1999/02/28 00:04:02 ivan +# removed misleading comments +# +# Revision 1.7 1999/01/19 05:14:21 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 09:41:45 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.5 1999/01/18 09:22:36 ivan +# changes to track email addresses for email invoicing +# +# Revision 1.4 1998/12/23 03:09:19 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 09:57:23 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/12/16 05:24:29 ivan +# use FS::Conf; +# use strict; -use 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 $_ !~ /^(#|$)/, ; - -my($cgi) = new CGI::Base; -$cgi->get; +use vars qw( $conf $cgi $mydomain $query $svcnum $svc_acct $cust_svc $pkgnum + $cust_pkg $custnum $part_svc $p $svc_acct_pop $password ); +use CGI; +use CGI::Carp qw( fatalsToBrowser ); +use FS::UID qw( cgisuidsetup ); +use FS::CGI qw( header popurl menubar); +use FS::Record qw( qsearchs fields ); +use FS::Conf; +use FS::svc_acct; +use FS::cust_svc; +use FS::cust_pkg; +use FS::part_svc; +use FS::svc_acct_pop; + +$cgi = new CGI; &cgisuidsetup($cgi); -#untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; -my($svc_acct)=qsearchs('svc_acct',{'svcnum'=>$svcnum}); -die "Unkonwn svcnum" unless $svc_acct; +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); + +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; +$svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum}); +die "Unknown svcnum" unless $svc_acct; -my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); -my($pkgnum)=$cust_svc->getfield('pkgnum'); -my($cust_pkg,$custnum); +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); -} - -my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); -die "Unkonwn svcpart" unless $part_svc; - -SendHeaders(); # one guess. -print < - - Account View - - -

                Account View

                - -
                -END - -if ($pkgnum || $custnum) { - print <View this package (#$pkgnum) | -View this customer (#$custnum) | -END } else { - print <Cancel this (unaudited)account | -END + $cust_pkg = ''; + $custnum = ''; } -print <Main menu

                -Service #$svcnum -END +$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); +die "Unknown svcpart" unless $part_svc; + +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Account View', menubar( + ( ( $pkgnum || $custnum ) + ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum", + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", + ) + : ( "Cancel this (unaudited) account" => + "${p}misc/cancel-unaudited.cgi?$svcnum" ) + ), + "Main menu" => $p, +)); -print qq!
                Edit this information!; #print qq!
                Send account information!; -print qq!

                General | Shell account | !; -print qq!SLIP/PPP account
                !; -#formatting -print qq!
                General
                !; - -#svc -print "Service: ", $part_svc->svc, ""; - -#username -print "
                Username: ", $svc_acct->username, ""; - -#password -if (substr($svc_acct->_password,0,1) eq "*") { - print "
                Password: (Login disabled)
                "; +print qq!Edit this information!, + "
                Service #$svcnum", + "
                Service: ", $part_svc->svc, "", + "

                Username: ", $svc_acct->username, "" +; + +print "
                Password: "; +$password = $svc_acct->_password; +if ( $password =~ /^\*\w+\* (.*)$/ ) { + $password = $1; + print "(login disabled) "; +} +if ( $conf->exists('showpasswords') ) { + print "$password"; } else { - print "
                Password: (hidden)
                "; + print "(hidden)"; } +$password = ''; -# popnum -> svc_acct_pop record -my($svc_acct_pop)=qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum}); - -#pop -print "POP: ", $svc_acct_pop->city, ", ", $svc_acct_pop->state, - " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "<\B>" +$svc_acct_pop = qsearchs('svc_acct_pop',{'popnum'=>$svc_acct->popnum}); +print "
                POP: ", $svc_acct_pop->city, ", ", $svc_acct_pop->state, + " (", $svc_acct_pop->ac, ")/", $svc_acct_pop->exch, "" if $svc_acct_pop; -#shell account -print qq!
                !; if ($svc_acct->uid ne '') { - print "Shell account"; - print "
                "; - print "Uid: ", $svc_acct->uid, ""; - print "
                Gid: ", $svc_acct->gid, ""; - - print qq!
                Finger name: !, $svc_acct->finger, qq!
                !; - - print "Home directory: ", $svc_acct->dir, "
                "; - - print "Shell: ", $svc_acct->shell, "
                "; - - print "Quota: ", $svc_acct->quota, " (unimplemented)"; + print "

                Uid: ", $svc_acct->uid, "", + "
                Gid: ", $svc_acct->gid, "", + "
                Finger name: ", $svc_acct->finger, "", + "
                Home directory: ", $svc_acct->dir, "", + "
                Shell: ", $svc_acct->shell, "", + "
                Quota: ", $svc_acct->quota, " (unimplemented)" + ; } else { - print "No shell account.
                "; + print "

                (No shell account)"; } -# SLIP/PPP -print qq!
                !; if ($svc_acct->slipip) { - print "SLIP/PPP account
                "; - print "IP address: ", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "(Dynamic)" : $svc_acct->slipip ,""; + print "

                IP address: ", ( $svc_acct->slipip eq "0.0.0.0" || $svc_acct->slipip eq '0e0' ) ? "(Dynamic)" : $svc_acct->slipip ,""; my($attribute); foreach $attribute ( grep /^radius_/, fields('svc_acct') ) { #warn $attribute; @@ -158,15 +170,8 @@ if ($svc_acct->slipip) { print "
                Radius $pattribute: ". $svc_acct->getfield($attribute), ""; } } else { - print "No SLIP/PPP account
                " + print "

                (No SLIP/PPP account)"; } -print "
                "; - - #formatting - print < - -END +print ""; diff --git a/htdocs/view/svc_acct_sm.cgi b/htdocs/view/svc_acct_sm.cgi index 42623eefd..072c94d44 100755 --- a/htdocs/view/svc_acct_sm.cgi +++ b/htdocs/view/svc_acct_sm.cgi @@ -1,12 +1,10 @@ #!/usr/bin/perl -Tw # -# View svc_acct_sm records +# $Id: svc_acct_sm.cgi,v 1.11 2000-07-17 10:58:42 ivan Exp $ # # Usage: svc_acct_sm.cgi svcnum # http://server.name/path/svc_acct_sm.cgi?svcnum # -# Note: Should be run setuid freeside as user nobody. -# # based on view/svc_acct.cgi # # ivan@voicenet.com 97-jan-5 @@ -20,95 +18,111 @@ # bmccane@maxbaud.net 98-apr-3 # # /var/spool/freeside/conf/domain ivan@sisd.com 98-jul-17 +# +# $Log: svc_acct_sm.cgi,v $ +# Revision 1.11 2000-07-17 10:58:42 ivan +# better error messages if svc_acct or svc_domain records are missing +# +# Revision 1.10 1999/04/08 12:00:19 ivan +# aesthetic update +# +# Revision 1.9 1999/02/28 00:04:03 ivan +# removed misleading comments +# +# Revision 1.8 1999/02/09 09:23:00 ivan +# visual and bugfixes +# +# Revision 1.7 1999/02/07 09:59:42 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.6 1999/01/19 05:14:22 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:46 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 03:09:52 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 09:57:24 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/12/16 05:24:30 ivan +# use FS::Conf; +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw($conf $cgi $mydomain $query $svcnum $svc_acct_sm $cust_svc + $pkgnum $cust_pkg $custnum $part_svc $p $domsvc $domuid $domuser + $svc $svc_domain $domain $svc_acct $username ); +use CGI; use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header popurl menubar ); use FS::Record qw(qsearchs); - -my($conf_domain)="/var/spool/freeside/conf/domain"; -open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!"; -my($mydomain)=map { - /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file - $1 -} grep $_ !~ /^(#|$)/, ; -close DOMAIN; - -my($cgi) = new CGI::Base; -$cgi->get; +use FS::Conf; +use FS::svc_acct_sm; +use FS::cust_svc; +use FS::cust_pkg; +use FS::part_svc; +use FS::svc_domain; +use FS::svc_acct; + +$cgi = new CGI; cgisuidsetup($cgi); -#untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; -my($svc_acct_sm)=qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}); +$conf = new FS::Conf; +$mydomain = $conf->config('domain'); + +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; +$svc_acct_sm = qsearchs('svc_acct_sm',{'svcnum'=>$svcnum}); die "Unknown svcnum" unless $svc_acct_sm; -my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); -my($pkgnum)=$cust_svc->getfield('pkgnum'); -my($cust_pkg,$custnum); +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); -} - -my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); -die "Unkonwn svcpart" unless $part_svc; - -SendHeaders(); # one guess. -print < - - Mail Alias View - - -

                Mail Alias View

                -END -if ($pkgnum || $custnum) { - print <View this package (#$pkgnum) | -View this customer (#$custnum) | -END } else { - print <Cancel this (unaudited)account | -END + $cust_pkg = ''; + $custnum = ''; } -print <Main menu
                Service #$svcnum -

                Edit this information - -END - -my($domsvc,$domuid,$domuser)=( +$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ) + or die "Unkonwn svcpart"; + +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Mail Alias View', menubar( + ( ( $pkgnum || $custnum ) + ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum", + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", + ) + : ( "Cancel this (unaudited) account" => + "${p}misc/cancel-unaudited.cgi?$svcnum" ) + ), + "Main menu" => $p, +)); + +($domsvc,$domuid,$domuser) = ( $svc_acct_sm->domsvc, $svc_acct_sm->domuid, $svc_acct_sm->domuser, ); -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!


                !; - -#svc -print "Service: $svc"; - -print "
                "; - -print qq!Mail to !, ( ($domuser eq '*') ? "(anything)" : $domuser ) , qq!\@$domain forwards to $username\@$mydomain mailbox.!; - -print "
                "; - - #formatting - print < - -END +$svc = $part_svc->svc; +$svc_domain = qsearchs('svc_domain',{'svcnum'=>$domsvc}) + or die "Corrupted database: no svc_domain.svcnum matching domsvc $domsvc"; +$domain = $svc_domain->domain; +$svc_acct = qsearchs('svc_acct',{'uid'=>$domuid}) + or die "Corrupted database: no svc_acct.uid matching domuid $domuid"; +$username = $svc_acct->username; + +print qq!Edit this information!, + "
                Service #$svcnum", + "
                Service: $svc", + qq!
                Mail to !, ( ($domuser eq '*') ? "(anything)" : $domuser ) , qq!\@$domain forwards to $username\@$mydomain mailbox.!, + '' +; diff --git a/htdocs/view/svc_domain.cgi b/htdocs/view/svc_domain.cgi index 78ff6ac0b..85c854ee0 100755 --- a/htdocs/view/svc_domain.cgi +++ b/htdocs/view/svc_domain.cgi @@ -1,76 +1,102 @@ #!/usr/bin/perl -Tw # -# View svc_domain records +# $Id: svc_domain.cgi,v 1.11 2000-12-03 15:14:00 ivan Exp $ # # Usage: svc_domain svcnum # http://server.name/path/svc_domain.cgi?svcnum # -# Note: Should be run setuid freeside as user nobody. -# # ivan@voicenet.com 97-jan-6 # # rewrite ivan@sisd.com 98-mar-14 # # Changes to allow page to work at a relative position in server # bmccane@maxbaud.net 98-apr-3 +# +# $Log: svc_domain.cgi,v $ +# Revision 1.11 2000-12-03 15:14:00 ivan +# bugfixes from Jeff Finucane , thanks! +# +# Revision 1.10 1999/08/27 22:18:44 ivan +# point to patrick instead of internic! +# +# Revision 1.9 1999/04/08 12:00:19 ivan +# aesthetic update +# +# Revision 1.8 1999/02/28 00:04:04 ivan +# removed misleading comments +# +# Revision 1.7 1999/02/23 08:09:25 ivan +# beginnings of one-screen new customer entry and some other miscellania +# +# Revision 1.6 1999/01/19 05:14:23 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.5 1999/01/18 09:41:47 ivan +# all $cgi->header calls now include ( '-expires' => 'now' ) for mod_perl +# (good idea anyway) +# +# Revision 1.4 1998/12/23 03:10:19 ivan +# $cgi->keywords instead of $cgi->query_string +# +# Revision 1.3 1998/12/17 09:57:25 ivan +# s/CGI::(Base|Request)/CGI.pm/; +# +# Revision 1.2 1998/11/13 09:56:50 ivan +# change configuration file layout to support multiple distinct databases (with +# own set of config files, export, etc.) +# use strict; -use CGI::Base qw(:DEFAULT :CGI); +use vars qw( $cgi $query $svcnum $svc_domain $domain $cust_svc $pkgnum + $cust_pkg $custnum $part_svc $p ); +use CGI; use FS::UID qw(cgisuidsetup); +use FS::CGI qw(header menubar popurl menubar); use FS::Record qw(qsearchs); +use FS::svc_domain; +use FS::cust_svc; +use FS::cust_pkg; +use FS::part_svc; -my($cgi) = new CGI::Base; -$cgi->get; +$cgi = new CGI; cgisuidsetup($cgi); -#untaint svcnum -$QUERY_STRING =~ /^(\d+)$/; -my($svcnum)=$1; -my($svc_domain)=qsearchs('svc_domain',{'svcnum'=>$svcnum}); +($query) = $cgi->keywords; +$query =~ /^(\d+)$/; +$svcnum = $1; +$svc_domain = qsearchs('svc_domain',{'svcnum'=>$svcnum}); die "Unknown svcnum" unless $svc_domain; -my($domain)=$svc_domain->domain; -my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); -my($pkgnum)=$cust_svc->getfield('pkgnum'); -my($cust_pkg,$custnum); +$cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum}); +$pkgnum = $cust_svc->getfield('pkgnum'); if ($pkgnum) { $cust_pkg=qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); $custnum=$cust_pkg->getfield('custnum'); +} else { + $cust_pkg = ''; + $custnum = ''; } -my($part_svc)=qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); +$part_svc = qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); die "Unkonwn svcpart" unless $part_svc; -SendHeaders(); # one guess. -print < - - Domain View - - -

                Domain View

                - -
                -View this package (#$pkgnum) | -View this customer (#$custnum) | -Main menu

                - Service #$svcnum -
                -END - -print "
                "; -print "Service: ", $part_svc->svc, ""; -print "
                "; - -print qq!Domain name $domain.!; -print qq!

                View whois information.!; - -print "


                "; - - #formatting - print < - -END +$domain = $svc_domain->domain; +$p = popurl(2); +print $cgi->header( '-expires' => 'now' ), header('Domain View', menubar( + ( ( $pkgnum || $custnum ) + ? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum", + "View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum", + ) + : ( "Cancel this (unaudited) account" => + "${p}misc/cancel-unaudited.cgi?$svcnum" ) + ), + "Main menu" => $p, +)), + "Service #$svcnum", + "
                Service: ", $part_svc->svc, "", + "
                Domain name: $domain.", + qq!

                View whois information.!, + '', +; diff --git a/site_perl/Bill.pm b/site_perl/Bill.pm deleted file mode 100644 index 4d7e059ed..000000000 --- a/site_perl/Bill.pm +++ /dev/null @@ -1,44 +0,0 @@ -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; diff --git a/site_perl/CGI.pm b/site_perl/CGI.pm deleted file mode 100644 index d2ed52122..000000000 --- a/site_perl/CGI.pm +++ /dev/null @@ -1,143 +0,0 @@ -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)=@_; - - < - - - $title - - - -
                -

                - $title -

                - $menubar -
                -
                -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!$item!; - } - join(' | ',@html); -} - -=item idiot ERROR - -Sends headers and an HTML error message. - -=cut - -sub idiot { - my($error)=@_; - CGI::Base::SendHeaders(); - print < - - Error processing your request - - -
                -

                Error processing your request

                -
                - Your request could not be processed because of the following error: -

                $error -

                Hit the Back button in your web browser, correct this mistake, and try again. - - -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 - -=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; - - diff --git a/site_perl/Conf.pm b/site_perl/Conf.pm deleted file mode 100644 index d3ef307c0..000000000 --- a/site_perl/Conf.pm +++ /dev/null @@ -1,113 +0,0 @@ -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 98-sep-6 - -sub exists forgot to fetch $dir ivan@sisd.com 98-sep-27 - -=cut - -1; diff --git a/site_perl/Invoice.pm b/site_perl/Invoice.pm deleted file mode 100644 index 5eb596fad..000000000 --- a/site_perl/Invoice.pm +++ /dev/null @@ -1,45 +0,0 @@ -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; - diff --git a/site_perl/Record.pm b/site_perl/Record.pm deleted file mode 100644 index 9b308508a..000000000 --- a/site_perl/Record.pm +++ /dev/null @@ -1,868 +0,0 @@ -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 -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 Bs 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 method -on primary keys and single-field unique columns (see L). -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), 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. - -=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) unless VALUE is a number and the column -type (see L) 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). - -=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, L, L - -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; - diff --git a/site_perl/SSH.pm b/site_perl/SSH.pm deleted file mode 100644 index d5a0df654..000000000 --- a/site_perl/SSH.pm +++ /dev/null @@ -1,157 +0,0 @@ -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(); - $x =~ /^y/i; -} - -=head1 BUGS - -Not OO. - -scp stuff should transparantly use rsync-over-ssh instead. - -=head1 SEE ALSO - -L, L, L, L - -=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; - diff --git a/site_perl/UID.pm b/site_perl/UID.pm deleted file mode 100644 index 16f03a0ec..000000000 --- a/site_perl/UID.pm +++ /dev/null @@ -1,209 +0,0 @@ -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, L, L - -=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; - diff --git a/site_perl/agent.pm b/site_perl/agent.pm deleted file mode 100644 index 7fc370ed0..000000000 --- a/site_perl/agent.pm +++ /dev/null @@ -1,166 +0,0 @@ -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 - -=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, L, L, 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; - diff --git a/site_perl/agent_type.pm b/site_perl/agent_type.pm deleted file mode 100644 index 002c36f54..000000000 --- a/site_perl/agent_type.pm +++ /dev/null @@ -1,161 +0,0 @@ -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) has an agent type. Agent types define which packages (see -L) may be purchased by customers (see L), via -FS::type_pkgs records (see L). 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, L, L, L, -L, 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; - diff --git a/site_perl/cust_bill.pm b/site_perl/cust_bill.pm deleted file mode 100644 index 00234519a..000000000 --- a/site_perl/cust_bill.pm +++ /dev/null @@ -1,495 +0,0 @@ -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) - -=item _date - specified as a UNIX timestamp; see L. Also see -L and L 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). - -=item printed - how many times this invoice has been printed automatically -(see L). - -=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). - -=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). Printed is normally updated by -calling the collect method of a customer object (see L). - -=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) 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) 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) 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. Also see -L and L 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)=; - close CHILD; - return @collect; - } else { #child - - my($description,$amount); - my(@buf); - - #define format stuff - $%=0; - $= = 35; - local($^L) = <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, L, L, L, -L, 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; - diff --git a/site_perl/cust_bill_pkg.pm b/site_perl/cust_bill_pkg.pm deleted file mode 100644 index e41d7c12c..000000000 --- a/site_perl/cust_bill_pkg.pm +++ /dev/null @@ -1,177 +0,0 @@ -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) - -=item pkgnum - package (see L) - -=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. Also -see L and L 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). - -=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, L, L, L, schema.html -from the base documentation. - -=head1 HISTORY - -ivan@sisd.com 98-mar-13 - -pod ivan@sisd.com 98-sep-21 - -=cut - -1; - diff --git a/site_perl/cust_credit.pm b/site_perl/cust_credit.pm deleted file mode 100644 index b1a5e1649..000000000 --- a/site_perl/cust_credit.pm +++ /dev/null @@ -1,199 +0,0 @@ -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) - -=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). - -=item _date - specified as a UNIX timestamp; see L. Also see -L and L for conversion functions. - -=item otaker - order taker (assigned automatically, see L) - -=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). - -=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, L, L, 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; - diff --git a/site_perl/cust_main.pm b/site_perl/cust_main.pm deleted file mode 100644 index ec282731e..000000000 --- a/site_perl/cust_main.pm +++ /dev/null @@ -1,868 +0,0 @@ -#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) - -=item refnum - referral (see L) - -=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) - -=item state - (see L) - -=item zip - -=item country - (see L) - -=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) - -=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 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) 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) for this customer. - -=cut - -sub ncancelled_pkgs { - my($self)=@_; - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }); -} - -=item bill OPTIONS - -Generates invoices (see L) 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). Also see L and L 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). 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). Also see L and L -for conversion functions. - -batch_card - Set this true to batch cards (see L). 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). - -=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) 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, L, L, L -L, L, L, -L, L, 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; - - diff --git a/site_perl/cust_main_county.pm b/site_perl/cust_main_county.pm deleted file mode 100644 index f4b4595ae..000000000 --- a/site_perl/cust_main_county.pm +++ /dev/null @@ -1,161 +0,0 @@ -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, L, L, 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; - diff --git a/site_perl/cust_pay.pm b/site_perl/cust_pay.pm deleted file mode 100644 index 6e30c595b..000000000 --- a/site_perl/cust_pay.pm +++ /dev/null @@ -1,235 +0,0 @@ -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) - -=item paid - Amount of this payment - -=item _date - specified as a UNIX timestamp; see L. Also see -L and L 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). - -=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, L, 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; - diff --git a/site_perl/cust_pkg.pm b/site_perl/cust_pkg.pm deleted file mode 100644 index 7dc5aa7ec..000000000 --- a/site_perl/cust_pkg.pm +++ /dev/null @@ -1,507 +0,0 @@ -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) - -=item pkgpart - Billing item definition (see L) - -=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) - -=back - -Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps; -see L. Also see L and L 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). - -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 and L) -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 and L) 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 and L) 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) - -PKGPARTS is a list of pkgparts specifying the the billing item definitions (see -L) 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) are moved to the -new billing items. An error is returned if this is not possible (see -L). - -=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, L, L, L -, L, 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; - diff --git a/site_perl/cust_refund.pm b/site_perl/cust_refund.pm deleted file mode 100644 index a30f21716..000000000 --- a/site_perl/cust_refund.pm +++ /dev/null @@ -1,233 +0,0 @@ -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) - -=item refund - Amount of the refund - -=item _date - specified as a UNIX timestamp; see L. Also see -L and L 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) - -=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). - -=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, L, 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; - diff --git a/site_perl/cust_svc.pm b/site_perl/cust_svc.pm deleted file mode 100644 index 1d5051b1f..000000000 --- a/site_perl/cust_svc.pm +++ /dev/null @@ -1,168 +0,0 @@ -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) - -=item svcpart - Service definition (see L) - -=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, L, and L, 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). - -=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, L, L, L, -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; - diff --git a/site_perl/dbdef.pm b/site_perl/dbdef.pm deleted file mode 100644 index ac31bff0b..000000000 --- a/site_perl/dbdef.pm +++ /dev/null @@ -1,174 +0,0 @@ -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('',); #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, L, - -=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; - diff --git a/site_perl/dbdef_colgroup.pm b/site_perl/dbdef_colgroup.pm deleted file mode 100644 index 64f2e3082..000000000 --- a/site_perl/dbdef_colgroup.pm +++ /dev/null @@ -1,107 +0,0 @@ -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, L, L, -L, L, L - -=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; - diff --git a/site_perl/dbdef_column.pm b/site_perl/dbdef_column.pm deleted file mode 100644 index 023b57d1f..000000000 --- a/site_perl/dbdef_column.pm +++ /dev/null @@ -1,175 +0,0 @@ -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). - -=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, 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, L, L - -=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; - diff --git a/site_perl/dbdef_index.pm b/site_perl/dbdef_index.pm deleted file mode 100644 index 2097db1ea..000000000 --- a/site_perl/dbdef_index.pm +++ /dev/null @@ -1,43 +0,0 @@ -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_unique inherits from FS::dbdef_colgroup. - -=head1 BUGS - -Is this empty subclass needed? - -=head1 SEE ALSO - -L, L, L - -=head1 HISTORY - -class for dealing with index definitions - -ivan@sisd.com 98-apr-19 - -pod ivan@sisd.com 98-sep-24 - -=cut - -1; - diff --git a/site_perl/dbdef_table.pm b/site_perl/dbdef_table.pm deleted file mode 100644 index bc1454d9e..000000000 --- a/site_perl/dbdef_table.pm +++ /dev/null @@ -1,249 +0,0 @@ -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) 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, 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, L, L, L, -L - -=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; - diff --git a/site_perl/dbdef_unique.pm b/site_perl/dbdef_unique.pm deleted file mode 100644 index 4ec40de60..000000000 --- a/site_perl/dbdef_unique.pm +++ /dev/null @@ -1,44 +0,0 @@ -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_unique inherits from FS::dbdef_colgroup. - -=head1 BUGS - -Is this empty subclass needed? - -=head1 SEE ALSO - -L, L, L - -=head1 HISTORY - -class for dealing with unique definitions - -ivan@sisd.com 98-apr-19 - -pod ivan@sisd.com 98-sep-24 - -=cut - -1; - - diff --git a/site_perl/part_pkg.pm b/site_perl/part_pkg.pm deleted file mode 100644 index d1c12e47e..000000000 --- a/site_perl/part_pkg.pm +++ /dev/null @@ -1,168 +0,0 @@ -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, L, L, L, L. -schema.html from the base documentation. - -=head1 HISTORY - -ivan@sisd.com 97-dec-5 - -pod ivan@sisd.com 98-sep-21 - -=cut - -1; - diff --git a/site_perl/part_referral.pm b/site_perl/part_referral.pm deleted file mode 100644 index 1b4a1b65a..000000000 --- a/site_perl/part_referral.pm +++ /dev/null @@ -1,155 +0,0 @@ -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, L, 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; - diff --git a/site_perl/part_svc.pm b/site_perl/part_svc.pm deleted file mode 100644 index 0fd8ee47d..000000000 --- a/site_perl/part_svc.pm +++ /dev/null @@ -1,199 +0,0 @@ -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, -L, and L, among others. - -=item I__I - Default or fixed value for I in I. - -=item I__I_flag - defines I__I 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, L, L, L, -L, L, L, 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; - diff --git a/site_perl/pkg_svc.pm b/site_perl/pkg_svc.pm deleted file mode 100644 index 517125c01..000000000 --- a/site_perl/pkg_svc.pm +++ /dev/null @@ -1,168 +0,0 @@ -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) to -a service definition (see L). FS::pkg_svc inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item pkgpart - Billing item definition (see L) - -=item svcpart - Service definition (see L) - -=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, L, L, 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; - diff --git a/site_perl/svc_acct.pm b/site_perl/svc_acct.pm deleted file mode 100644 index a43af6b1a..000000000 --- a/site_perl/svc_acct.pm +++ /dev/null @@ -1,557 +0,0 @@ -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) - -=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 - I - -=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) should be -defined. An FS::cust_svc record will be created and inserted. - -If the configuration value (see L) 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) 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) 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). - -=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). - -=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). - -=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. - -=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, L, L, L, L, -L, L, L, 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; - diff --git a/site_perl/svc_acct_pop.pm b/site_perl/svc_acct_pop.pm deleted file mode 100644 index a6f801f22..000000000 --- a/site_perl/svc_acct_pop.pm +++ /dev/null @@ -1,163 +0,0 @@ -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, L, 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; - diff --git a/site_perl/svc_acct_sm.pm b/site_perl/svc_acct_sm.pm deleted file mode 100644 index c87ed2c54..000000000 --- a/site_perl/svc_acct_sm.pm +++ /dev/null @@ -1,350 +0,0 @@ -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) - -=item domuid - uid of the target account (see L) - -=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) should be -defined. An FS::cust_svc record will be created and inserted. - -If the configuration values (see L) 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). -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). - -=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). - -=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). - -=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. - -=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, L, L, L, L, -L, L, L, L, L, -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; - diff --git a/site_perl/svc_domain.pm b/site_perl/svc_domain.pm deleted file mode 100644 index 1ddd5b290..000000000 --- a/site_perl/svc_domain.pm +++ /dev/null @@ -1,539 +0,0 @@ -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 $_ !~ /^(#|$)/, ; -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 $_ !~ /^(#|$)/, ; -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 $_ !~ /^(#|$)/, ; -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 $_ !~ /^(#|$)/, ; -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 $_ !~ /^(#|$)/, ; -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"; -}